root / src / Ganeti / Query / Server.hs @ 0349f9c6
History | View | Annotate | Download (19.2 kB)
1 | d120506c | Agata Murawska | {-| Implementation of the Ganeti Query2 server. |
---|---|---|---|
2 | 25b54de0 | Iustin Pop | |
3 | 25b54de0 | Iustin Pop | -} |
4 | 25b54de0 | Iustin Pop | |
5 | 25b54de0 | Iustin Pop | {- |
6 | 25b54de0 | Iustin Pop | |
7 | 72747d91 | Iustin Pop | Copyright (C) 2012, 2013 Google Inc. |
8 | 25b54de0 | Iustin Pop | |
9 | 25b54de0 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | 25b54de0 | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | 25b54de0 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | 25b54de0 | Iustin Pop | (at your option) any later version. |
13 | 25b54de0 | Iustin Pop | |
14 | 25b54de0 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | 25b54de0 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | 25b54de0 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | 25b54de0 | Iustin Pop | General Public License for more details. |
18 | 25b54de0 | Iustin Pop | |
19 | 25b54de0 | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | 25b54de0 | Iustin Pop | along with this program; if not, write to the Free Software |
21 | 25b54de0 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | 25b54de0 | Iustin Pop | 02110-1301, USA. |
23 | 25b54de0 | Iustin Pop | |
24 | 25b54de0 | Iustin Pop | -} |
25 | 25b54de0 | Iustin Pop | |
26 | 4cab6703 | Iustin Pop | module Ganeti.Query.Server |
27 | 670e954a | Thomas Thrainer | ( main |
28 | 670e954a | Thomas Thrainer | , checkMain |
29 | 670e954a | Thomas Thrainer | , prepMain |
30 | 0d0ac025 | Iustin Pop | ) where |
31 | 25b54de0 | Iustin Pop | |
32 | f2374060 | Iustin Pop | import Control.Applicative |
33 | 25b54de0 | Iustin Pop | import Control.Concurrent |
34 | 25b54de0 | Iustin Pop | import Control.Exception |
35 | c6013594 | Klaus Aehlig | import Control.Monad (forever, when, zipWithM, liftM) |
36 | f9666f00 | Petr Pudlak | import Control.Monad.IO.Class |
37 | 25b54de0 | Iustin Pop | import Data.Bits (bitSize) |
38 | c87997d2 | Jose A. Lopes | import qualified Data.Set as Set (toList) |
39 | 670e954a | Thomas Thrainer | import Data.IORef |
40 | be7531a9 | Klaus Aehlig | import Data.Maybe (fromMaybe) |
41 | 25b54de0 | Iustin Pop | import qualified Text.JSON as J |
42 | 6222b3a3 | Klaus Aehlig | import Text.JSON (encode, showJSON, JSValue(..)) |
43 | 25b54de0 | Iustin Pop | import System.Info (arch) |
44 | d5665e10 | Klaus Aehlig | import System.Directory |
45 | 25b54de0 | Iustin Pop | |
46 | 25b54de0 | Iustin Pop | import qualified Ganeti.Constants as C |
47 | c87997d2 | Jose A. Lopes | import qualified Ganeti.ConstantUtils as ConstantUtils (unFrozenSet) |
48 | 5183e8be | Iustin Pop | import Ganeti.Errors |
49 | 9eeb0aa5 | Michael Hanselmann | import qualified Ganeti.Path as Path |
50 | 0d0ac025 | Iustin Pop | import Ganeti.Daemon |
51 | 25b54de0 | Iustin Pop | import Ganeti.Objects |
52 | f2374060 | Iustin Pop | import qualified Ganeti.Config as Config |
53 | 218e3b0f | Thomas Thrainer | import Ganeti.ConfigReader |
54 | 25b54de0 | Iustin Pop | import Ganeti.BasicTypes |
55 | e5fba493 | Klaus Aehlig | import Ganeti.JQueue |
56 | b5fa2700 | Klaus Aehlig | import Ganeti.JQScheduler |
57 | 74b3f734 | Petr Pudlak | import Ganeti.JSON (TimeAsDoubleJSON(..)) |
58 | 25b54de0 | Iustin Pop | import Ganeti.Logging |
59 | 25b54de0 | Iustin Pop | import Ganeti.Luxi |
60 | 4cab6703 | Iustin Pop | import qualified Ganeti.Query.Language as Qlang |
61 | 1c3231aa | Thomas Thrainer | import qualified Ganeti.Query.Cluster as QCluster |
62 | 7711f32b | Klaus Aehlig | import Ganeti.Path ( queueDir, jobQueueLockFile, jobQueueDrainFile |
63 | 7711f32b | Klaus Aehlig | , defaultMasterSocket) |
64 | 946f1fb3 | Klaus Aehlig | import Ganeti.Rpc |
65 | 4cbe9bda | Iustin Pop | import Ganeti.Query.Query |
66 | c4e0d065 | Klaus Aehlig | import Ganeti.Query.Filter (makeSimpleFilter) |
67 | 6e94b75c | Jose A. Lopes | import Ganeti.Types |
68 | c7003a76 | Petr Pudlak | import qualified Ganeti.UDSServer as U (Handler(..), listener) |
69 | 857cbfb1 | Klaus Aehlig | import Ganeti.Utils (lockFile, exitIfBad, watchFile, safeRenameFile) |
70 | 3cb9bd38 | Jose A. Lopes | import qualified Ganeti.Version as Version |
71 | 25b54de0 | Iustin Pop | |
72 | cd67e337 | Iustin Pop | -- | Helper for classic queries. |
73 | cd67e337 | Iustin Pop | handleClassicQuery :: ConfigData -- ^ Cluster config |
74 | cd67e337 | Iustin Pop | -> Qlang.ItemType -- ^ Query type |
75 | 037762a9 | Iustin Pop | -> [Either String Integer] -- ^ Requested names |
76 | 037762a9 | Iustin Pop | -- (empty means all) |
77 | cd67e337 | Iustin Pop | -> [String] -- ^ Requested fields |
78 | cd67e337 | Iustin Pop | -> Bool -- ^ Whether to do sync queries or not |
79 | 5183e8be | Iustin Pop | -> IO (GenericResult GanetiException JSValue) |
80 | c4e0d065 | Klaus Aehlig | handleClassicQuery _ _ _ _ True = |
81 | 5183e8be | Iustin Pop | return . Bad $ OpPrereqError "Sync queries are not allowed" ECodeInval |
82 | c4e0d065 | Klaus Aehlig | handleClassicQuery cfg qkind names fields _ = do |
83 | c4e0d065 | Klaus Aehlig | let flt = makeSimpleFilter (nameField qkind) names |
84 | cd67e337 | Iustin Pop | qr <- query cfg True (Qlang.Query qkind fields flt) |
85 | cd67e337 | Iustin Pop | return $ showJSON <$> (qr >>= queryCompat) |
86 | cd67e337 | Iustin Pop | |
87 | 25b54de0 | Iustin Pop | -- | Minimal wrapper to handle the missing config case. |
88 | 9131274c | Jose A. Lopes | handleCallWrapper :: MVar () -> JQStatus -> Result ConfigData |
89 | e5fba493 | Klaus Aehlig | -> LuxiOp -> IO (ErrorResult JSValue) |
90 | b5fa2700 | Klaus Aehlig | handleCallWrapper _ _ (Bad msg) _ = |
91 | 5183e8be | Iustin Pop | return . Bad . ConfigurationError $ |
92 | 5183e8be | Iustin Pop | "I do not have access to a valid configuration, cannot\ |
93 | 5183e8be | Iustin Pop | \ process queries: " ++ msg |
94 | b5fa2700 | Klaus Aehlig | handleCallWrapper qlock qstat (Ok config) op = handleCall qlock qstat config op |
95 | 25b54de0 | Iustin Pop | |
96 | 25b54de0 | Iustin Pop | -- | Actual luxi operation handler. |
97 | 9131274c | Jose A. Lopes | handleCall :: MVar () -> JQStatus |
98 | b5fa2700 | Klaus Aehlig | -> ConfigData -> LuxiOp -> IO (ErrorResult JSValue) |
99 | b5fa2700 | Klaus Aehlig | handleCall _ _ cdata QueryClusterInfo = |
100 | 25b54de0 | Iustin Pop | let cluster = configCluster cdata |
101 | 1c3231aa | Thomas Thrainer | master = QCluster.clusterMasterNodeName cdata |
102 | 25b54de0 | Iustin Pop | hypervisors = clusterEnabledHypervisors cluster |
103 | 966e1580 | Helga Velroyen | diskTemplates = clusterEnabledDiskTemplates cluster |
104 | 72747d91 | Iustin Pop | def_hv = case hypervisors of |
105 | 72747d91 | Iustin Pop | x:_ -> showJSON x |
106 | 72747d91 | Iustin Pop | [] -> JSNull |
107 | 25b54de0 | Iustin Pop | bits = show (bitSize (0::Int)) ++ "bits" |
108 | 25b54de0 | Iustin Pop | arch_tuple = [bits, arch] |
109 | 5b11f8db | Iustin Pop | obj = [ ("software_version", showJSON C.releaseVersion) |
110 | 5b11f8db | Iustin Pop | , ("protocol_version", showJSON C.protocolVersion) |
111 | 5b11f8db | Iustin Pop | , ("config_version", showJSON C.configVersion) |
112 | c87997d2 | Jose A. Lopes | , ("os_api_version", showJSON . maximum . |
113 | c87997d2 | Jose A. Lopes | Set.toList . ConstantUtils.unFrozenSet $ |
114 | c87997d2 | Jose A. Lopes | C.osApiVersions) |
115 | 5b11f8db | Iustin Pop | , ("export_version", showJSON C.exportVersion) |
116 | 3cb9bd38 | Jose A. Lopes | , ("vcs_version", showJSON Version.version) |
117 | 5b11f8db | Iustin Pop | , ("architecture", showJSON arch_tuple) |
118 | 25b54de0 | Iustin Pop | , ("name", showJSON $ clusterClusterName cluster) |
119 | 1c3231aa | Thomas Thrainer | , ("master", showJSON (case master of |
120 | 1c3231aa | Thomas Thrainer | Ok name -> name |
121 | 1c3231aa | Thomas Thrainer | _ -> undefined)) |
122 | 72747d91 | Iustin Pop | , ("default_hypervisor", def_hv) |
123 | 5b11f8db | Iustin Pop | , ("enabled_hypervisors", showJSON hypervisors) |
124 | a2160e57 | Iustin Pop | , ("hvparams", showJSON $ clusterHvparams cluster) |
125 | a2160e57 | Iustin Pop | , ("os_hvp", showJSON $ clusterOsHvp cluster) |
126 | 25b54de0 | Iustin Pop | , ("beparams", showJSON $ clusterBeparams cluster) |
127 | 25b54de0 | Iustin Pop | , ("osparams", showJSON $ clusterOsparams cluster) |
128 | 25b54de0 | Iustin Pop | , ("ipolicy", showJSON $ clusterIpolicy cluster) |
129 | 25b54de0 | Iustin Pop | , ("nicparams", showJSON $ clusterNicparams cluster) |
130 | 25b54de0 | Iustin Pop | , ("ndparams", showJSON $ clusterNdparams cluster) |
131 | a2160e57 | Iustin Pop | , ("diskparams", showJSON $ clusterDiskparams cluster) |
132 | 25b54de0 | Iustin Pop | , ("candidate_pool_size", |
133 | 25b54de0 | Iustin Pop | showJSON $ clusterCandidatePoolSize cluster) |
134 | 178ad717 | Klaus Aehlig | , ("max_running_jobs", |
135 | 178ad717 | Klaus Aehlig | showJSON $ clusterMaxRunningJobs cluster) |
136 | 25b54de0 | Iustin Pop | , ("master_netdev", showJSON $ clusterMasterNetdev cluster) |
137 | 25b54de0 | Iustin Pop | , ("master_netmask", showJSON $ clusterMasterNetmask cluster) |
138 | 25b54de0 | Iustin Pop | , ("use_external_mip_script", |
139 | 25b54de0 | Iustin Pop | showJSON $ clusterUseExternalMipScript cluster) |
140 | 64b0309a | Dimitris Aragiorgis | , ("volume_group_name", |
141 | 64b0309a | Dimitris Aragiorgis | maybe JSNull showJSON (clusterVolumeGroupName cluster)) |
142 | 25b54de0 | Iustin Pop | , ("drbd_usermode_helper", |
143 | 25b54de0 | Iustin Pop | maybe JSNull showJSON (clusterDrbdUsermodeHelper cluster)) |
144 | 25b54de0 | Iustin Pop | , ("file_storage_dir", showJSON $ clusterFileStorageDir cluster) |
145 | 25b54de0 | Iustin Pop | , ("shared_file_storage_dir", |
146 | 25b54de0 | Iustin Pop | showJSON $ clusterSharedFileStorageDir cluster) |
147 | d3e6fd0e | Santi Raffa | , ("gluster_storage_dir", |
148 | d3e6fd0e | Santi Raffa | showJSON $ clusterGlusterStorageDir cluster) |
149 | 25b54de0 | Iustin Pop | , ("maintain_node_health", |
150 | 25b54de0 | Iustin Pop | showJSON $ clusterMaintainNodeHealth cluster) |
151 | 74b3f734 | Petr Pudlak | , ("ctime", showJSON . TimeAsDoubleJSON $ clusterCtime cluster) |
152 | 74b3f734 | Petr Pudlak | , ("mtime", showJSON . TimeAsDoubleJSON $ clusterMtime cluster) |
153 | 25b54de0 | Iustin Pop | , ("uuid", showJSON $ clusterUuid cluster) |
154 | 25b54de0 | Iustin Pop | , ("tags", showJSON $ clusterTags cluster) |
155 | 25b54de0 | Iustin Pop | , ("uid_pool", showJSON $ clusterUidPool cluster) |
156 | 25b54de0 | Iustin Pop | , ("default_iallocator", |
157 | 25b54de0 | Iustin Pop | showJSON $ clusterDefaultIallocator cluster) |
158 | 0359e5d0 | Spyros Trigazis | , ("default_iallocator_params", |
159 | 0359e5d0 | Spyros Trigazis | showJSON $ clusterDefaultIallocatorParams cluster) |
160 | 25b54de0 | Iustin Pop | , ("reserved_lvs", showJSON $ clusterReservedLvs cluster) |
161 | 25b54de0 | Iustin Pop | , ("primary_ip_version", |
162 | 25b54de0 | Iustin Pop | showJSON . ipFamilyToVersion $ clusterPrimaryIpFamily cluster) |
163 | 7b9ceea7 | Helga Velroyen | , ("prealloc_wipe_disks", |
164 | 7b9ceea7 | Helga Velroyen | showJSON $ clusterPreallocWipeDisks cluster) |
165 | 7b9ceea7 | Helga Velroyen | , ("hidden_os", showJSON $ clusterHiddenOs cluster) |
166 | 7b9ceea7 | Helga Velroyen | , ("blacklisted_os", showJSON $ clusterBlacklistedOs cluster) |
167 | 966e1580 | Helga Velroyen | , ("enabled_disk_templates", showJSON diskTemplates) |
168 | 25b54de0 | Iustin Pop | ] |
169 | 25b54de0 | Iustin Pop | |
170 | 1c3231aa | Thomas Thrainer | in case master of |
171 | 1c3231aa | Thomas Thrainer | Ok _ -> return . Ok . J.makeObj $ obj |
172 | 1c3231aa | Thomas Thrainer | Bad ex -> return $ Bad ex |
173 | 25b54de0 | Iustin Pop | |
174 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (QueryTags kind name) = do |
175 | f2374060 | Iustin Pop | let tags = case kind of |
176 | 6e94b75c | Jose A. Lopes | TagKindCluster -> Ok . clusterTags $ configCluster cfg |
177 | e10c4a69 | Hrvoje Ribicic | TagKindGroup -> groupTags <$> Config.getGroup cfg name |
178 | e10c4a69 | Hrvoje Ribicic | TagKindNode -> nodeTags <$> Config.getNode cfg name |
179 | e10c4a69 | Hrvoje Ribicic | TagKindInstance -> instTags <$> Config.getInstance cfg name |
180 | e10c4a69 | Hrvoje Ribicic | TagKindNetwork -> networkTags <$> Config.getNetwork cfg name |
181 | 6e94b75c | Jose A. Lopes | return (J.showJSON <$> tags) |
182 | f2374060 | Iustin Pop | |
183 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (Query qkind qfields qfilter) = do |
184 | fa2c927c | Agata Murawska | result <- query cfg True (Qlang.Query qkind qfields qfilter) |
185 | 4cbe9bda | Iustin Pop | return $ J.showJSON <$> result |
186 | 4cbe9bda | Iustin Pop | |
187 | b5fa2700 | Klaus Aehlig | handleCall _ _ _ (QueryFields qkind qfields) = do |
188 | 518023a9 | Iustin Pop | let result = queryFields (Qlang.QueryFields qkind qfields) |
189 | 518023a9 | Iustin Pop | return $ J.showJSON <$> result |
190 | 518023a9 | Iustin Pop | |
191 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (QueryNodes names fields lock) = |
192 | 037762a9 | Iustin Pop | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRNode) |
193 | c4e0d065 | Klaus Aehlig | (map Left names) fields lock |
194 | cd67e337 | Iustin Pop | |
195 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (QueryInstances names fields lock) = |
196 | 89352544 | Helga Velroyen | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRInstance) |
197 | 89352544 | Helga Velroyen | (map Left names) fields lock |
198 | 89352544 | Helga Velroyen | |
199 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (QueryGroups names fields lock) = |
200 | 037762a9 | Iustin Pop | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRGroup) |
201 | c4e0d065 | Klaus Aehlig | (map Left names) fields lock |
202 | cd67e337 | Iustin Pop | |
203 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (QueryJobs names fields) = |
204 | a7e484c4 | Iustin Pop | handleClassicQuery cfg (Qlang.ItemTypeLuxi Qlang.QRJob) |
205 | c4e0d065 | Klaus Aehlig | (map (Right . fromIntegral . fromJobId) names) fields False |
206 | a7e484c4 | Iustin Pop | |
207 | b5fa2700 | Klaus Aehlig | handleCall _ _ cfg (QueryNetworks names fields lock) = |
208 | 795d035d | Klaus Aehlig | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRNetwork) |
209 | 795d035d | Klaus Aehlig | (map Left names) fields lock |
210 | 795d035d | Klaus Aehlig | |
211 | be7531a9 | Klaus Aehlig | handleCall _ _ cfg (QueryConfigValues fields) = do |
212 | be7531a9 | Klaus Aehlig | let params = [ ("cluster_name", return . showJSON . clusterClusterName |
213 | be7531a9 | Klaus Aehlig | . configCluster $ cfg) |
214 | be7531a9 | Klaus Aehlig | , ("watcher_pause", liftM (maybe JSNull showJSON) |
215 | be7531a9 | Klaus Aehlig | QCluster.isWatcherPaused) |
216 | be7531a9 | Klaus Aehlig | , ("master_node", return . genericResult (const JSNull) showJSON |
217 | be7531a9 | Klaus Aehlig | $ QCluster.clusterMasterNodeName cfg) |
218 | 1264bd58 | Klaus Aehlig | , ("drain_flag", liftM (showJSON . not) isQueueOpen) |
219 | be7531a9 | Klaus Aehlig | ] :: [(String, IO JSValue)] |
220 | be7531a9 | Klaus Aehlig | let answer = map (fromMaybe (return JSNull) . flip lookup params) fields |
221 | be7531a9 | Klaus Aehlig | answerEval <- sequence answer |
222 | be7531a9 | Klaus Aehlig | return . Ok . showJSON $ answerEval |
223 | be7531a9 | Klaus Aehlig | |
224 | 0349f9c6 | Klaus Aehlig | handleCall _ _ cfg (QueryExports nodes lock) = |
225 | 0349f9c6 | Klaus Aehlig | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRExport) |
226 | 0349f9c6 | Klaus Aehlig | (map Left nodes) ["node", "export"] lock |
227 | 0349f9c6 | Klaus Aehlig | |
228 | f9666f00 | Petr Pudlak | handleCall qlock qstat cfg (SubmitJobToDrainedQueue ops) = runResultT $ do |
229 | f5b765f0 | Klaus Aehlig | let mcs = Config.getMasterCandidates cfg |
230 | f9666f00 | Petr Pudlak | jid <- mkResultT $ allocateJobId mcs qlock |
231 | f9666f00 | Petr Pudlak | ts <- liftIO currentTimestamp |
232 | f9666f00 | Petr Pudlak | job <- liftM (setReceivedTimestamp ts) |
233 | f9666f00 | Petr Pudlak | $ queuedJobFromOpCodes jid ops |
234 | f9666f00 | Petr Pudlak | qDir <- liftIO queueDir |
235 | f9666f00 | Petr Pudlak | mkResultT $ writeJobToDisk qDir job |
236 | f9666f00 | Petr Pudlak | liftIO $ replicateManyJobs qDir mcs [job] |
237 | f9666f00 | Petr Pudlak | _ <- liftIO . forkIO $ enqueueNewJobs qstat [job] |
238 | f9666f00 | Petr Pudlak | return . showJSON . fromJobId $ jid |
239 | e5fba493 | Klaus Aehlig | |
240 | b5fa2700 | Klaus Aehlig | handleCall qlock qstat cfg (SubmitJob ops) = |
241 | e5fba493 | Klaus Aehlig | do |
242 | e5fba493 | Klaus Aehlig | open <- isQueueOpen |
243 | e5fba493 | Klaus Aehlig | if not open |
244 | e5fba493 | Klaus Aehlig | then return . Bad . GenericError $ "Queue drained" |
245 | b5fa2700 | Klaus Aehlig | else handleCall qlock qstat cfg (SubmitJobToDrainedQueue ops) |
246 | e5fba493 | Klaus Aehlig | |
247 | b5fa2700 | Klaus Aehlig | handleCall qlock qstat cfg (SubmitManyJobs lops) = |
248 | 94d6d0a3 | Klaus Aehlig | do |
249 | 94d6d0a3 | Klaus Aehlig | open <- isQueueOpen |
250 | 94d6d0a3 | Klaus Aehlig | if not open |
251 | 94d6d0a3 | Klaus Aehlig | then return . Bad . GenericError $ "Queue drained" |
252 | 94d6d0a3 | Klaus Aehlig | else do |
253 | f5b765f0 | Klaus Aehlig | let mcs = Config.getMasterCandidates cfg |
254 | f5b765f0 | Klaus Aehlig | result_jobids <- allocateJobIds mcs qlock (length lops) |
255 | 94d6d0a3 | Klaus Aehlig | case result_jobids of |
256 | 94d6d0a3 | Klaus Aehlig | Bad s -> return . Bad . GenericError $ s |
257 | 94d6d0a3 | Klaus Aehlig | Ok jids -> do |
258 | c6013594 | Klaus Aehlig | ts <- currentTimestamp |
259 | c6013594 | Klaus Aehlig | jobs <- liftM (map $ setReceivedTimestamp ts) |
260 | c6013594 | Klaus Aehlig | $ zipWithM queuedJobFromOpCodes jids lops |
261 | 94d6d0a3 | Klaus Aehlig | qDir <- queueDir |
262 | 94d6d0a3 | Klaus Aehlig | write_results <- mapM (writeJobToDisk qDir) jobs |
263 | f5b765f0 | Klaus Aehlig | let annotated_results = zip write_results jobs |
264 | 94d6d0a3 | Klaus Aehlig | succeeded = map snd $ filter (isOk . fst) annotated_results |
265 | 94d6d0a3 | Klaus Aehlig | when (any isBad write_results) . logWarning |
266 | 94d6d0a3 | Klaus Aehlig | $ "Writing some jobs failed " ++ show annotated_results |
267 | f5b765f0 | Klaus Aehlig | replicateManyJobs qDir mcs succeeded |
268 | b5fa2700 | Klaus Aehlig | _ <- forkIO $ enqueueNewJobs qstat succeeded |
269 | 94d6d0a3 | Klaus Aehlig | return . Ok . JSArray |
270 | f5b765f0 | Klaus Aehlig | . map (\(res, job) -> |
271 | 94d6d0a3 | Klaus Aehlig | if isOk res |
272 | f5b765f0 | Klaus Aehlig | then showJSON (True, fromJobId $ qjId job) |
273 | 94d6d0a3 | Klaus Aehlig | else showJSON (False, genericResult id (const "") res)) |
274 | 94d6d0a3 | Klaus Aehlig | $ annotated_results |
275 | 229da00f | Petr Pudlak | |
276 | 6222b3a3 | Klaus Aehlig | handleCall _ _ cfg (WaitForJobChange jid fields prev_job prev_log tmout) = do |
277 | 9131274c | Jose A. Lopes | let compute_fn = computeJobUpdate cfg jid fields prev_log |
278 | 6222b3a3 | Klaus Aehlig | qDir <- queueDir |
279 | 6222b3a3 | Klaus Aehlig | -- verify if the job is finalized, and return immediately in this case |
280 | 6222b3a3 | Klaus Aehlig | jobresult <- loadJobFromDisk qDir False jid |
281 | 6222b3a3 | Klaus Aehlig | case jobresult of |
282 | 6222b3a3 | Klaus Aehlig | Ok (job, _) | not (jobFinalized job) -> do |
283 | 6222b3a3 | Klaus Aehlig | let jobfile = liveJobFile qDir jid |
284 | 6222b3a3 | Klaus Aehlig | answer <- watchFile jobfile (min tmout C.luxiWfjcTimeout) |
285 | 6222b3a3 | Klaus Aehlig | (prev_job, JSArray []) compute_fn |
286 | 6222b3a3 | Klaus Aehlig | return . Ok $ showJSON answer |
287 | 6222b3a3 | Klaus Aehlig | _ -> liftM (Ok . showJSON) compute_fn |
288 | 6222b3a3 | Klaus Aehlig | |
289 | 946f1fb3 | Klaus Aehlig | handleCall _ _ cfg (SetWatcherPause time) = do |
290 | 946f1fb3 | Klaus Aehlig | let mcs = Config.getMasterCandidates cfg |
291 | 946f1fb3 | Klaus Aehlig | masters = genericResult (const []) return |
292 | 946f1fb3 | Klaus Aehlig | . Config.getNode cfg . clusterMasterNode |
293 | 946f1fb3 | Klaus Aehlig | $ configCluster cfg |
294 | 946f1fb3 | Klaus Aehlig | _ <- executeRpcCall (masters ++ mcs) $ RpcCallSetWatcherPause time |
295 | ed7f7fd9 | Petr Pudlak | return . Ok . maybe JSNull showJSON $ fmap TimeAsDoubleJSON time |
296 | 946f1fb3 | Klaus Aehlig | |
297 | d5665e10 | Klaus Aehlig | handleCall _ _ cfg (SetDrainFlag value) = do |
298 | d5665e10 | Klaus Aehlig | let mcs = Config.getMasterCandidates cfg |
299 | d5665e10 | Klaus Aehlig | fpath <- jobQueueDrainFile |
300 | d5665e10 | Klaus Aehlig | if value |
301 | d5665e10 | Klaus Aehlig | then writeFile fpath "" |
302 | d5665e10 | Klaus Aehlig | else removeFile fpath |
303 | d5665e10 | Klaus Aehlig | _ <- executeRpcCall mcs $ RpcCallSetDrainFlag value |
304 | d5665e10 | Klaus Aehlig | return . Ok . showJSON $ True |
305 | d5665e10 | Klaus Aehlig | |
306 | 7711f32b | Klaus Aehlig | handleCall _ qstat cfg (ChangeJobPriority jid prio) = do |
307 | 7711f32b | Klaus Aehlig | maybeJob <- setJobPriority qstat jid prio |
308 | 7711f32b | Klaus Aehlig | case maybeJob of |
309 | 7711f32b | Klaus Aehlig | Bad s -> return . Ok $ showJSON (False, s) |
310 | 7711f32b | Klaus Aehlig | Ok (Just job) -> runResultT $ do |
311 | 7711f32b | Klaus Aehlig | let mcs = Config.getMasterCandidates cfg |
312 | 7711f32b | Klaus Aehlig | qDir <- liftIO queueDir |
313 | 7711f32b | Klaus Aehlig | liftIO $ replicateManyJobs qDir mcs [job] |
314 | 7711f32b | Klaus Aehlig | return $ showJSON (True, "Priorities of pending opcodes for job " |
315 | 7711f32b | Klaus Aehlig | ++ show (fromJobId jid) ++ " have been changed" |
316 | 7711f32b | Klaus Aehlig | ++ " to " ++ show prio) |
317 | 7711f32b | Klaus Aehlig | Ok Nothing -> runResultT $ do |
318 | 7711f32b | Klaus Aehlig | -- Job has already started; so we have to forward the request |
319 | 7711f32b | Klaus Aehlig | -- to the job, currently handled by masterd. |
320 | 7711f32b | Klaus Aehlig | socketpath <- liftIO defaultMasterSocket |
321 | 7711f32b | Klaus Aehlig | cl <- liftIO $ getLuxiClient socketpath |
322 | 7711f32b | Klaus Aehlig | ResultT $ callMethod (ChangeJobPriority jid prio) cl |
323 | 7711f32b | Klaus Aehlig | |
324 | 36cb6837 | Klaus Aehlig | handleCall _ qstat cfg (CancelJob jid) = do |
325 | 36cb6837 | Klaus Aehlig | let jName = (++) "job " . show $ fromJobId jid |
326 | 36cb6837 | Klaus Aehlig | dequeueResult <- dequeueJob qstat jid |
327 | 36cb6837 | Klaus Aehlig | case dequeueResult of |
328 | 36cb6837 | Klaus Aehlig | Ok True -> do |
329 | 36cb6837 | Klaus Aehlig | logDebug $ jName ++ " dequeued, marking as canceled" |
330 | 36cb6837 | Klaus Aehlig | qDir <- queueDir |
331 | 36cb6837 | Klaus Aehlig | readResult <- loadJobFromDisk qDir True jid |
332 | 36cb6837 | Klaus Aehlig | let jobFileFailed = return . Ok . showJSON . (,) False |
333 | 36cb6837 | Klaus Aehlig | . (++) ("Dequeued " ++ jName |
334 | 36cb6837 | Klaus Aehlig | ++ ", but failed to mark as cancelled: ") |
335 | 36cb6837 | Klaus Aehlig | :: String -> IO (ErrorResult JSValue) |
336 | 36cb6837 | Klaus Aehlig | case readResult of |
337 | 36cb6837 | Klaus Aehlig | Bad s -> jobFileFailed s |
338 | 36cb6837 | Klaus Aehlig | Ok (job, _) -> do |
339 | 36cb6837 | Klaus Aehlig | now <- currentTimestamp |
340 | 36cb6837 | Klaus Aehlig | let job' = cancelQueuedJob now job |
341 | 36cb6837 | Klaus Aehlig | mcs = Config.getMasterCandidates cfg |
342 | 36cb6837 | Klaus Aehlig | write_result <- writeJobToDisk qDir job' |
343 | 36cb6837 | Klaus Aehlig | case write_result of |
344 | 36cb6837 | Klaus Aehlig | Bad s -> jobFileFailed s |
345 | 36cb6837 | Klaus Aehlig | Ok () -> do |
346 | 36cb6837 | Klaus Aehlig | replicateManyJobs qDir mcs [job'] |
347 | 36cb6837 | Klaus Aehlig | return . Ok . showJSON $ (True, "Dequeued " ++ jName) |
348 | 36cb6837 | Klaus Aehlig | Ok False -> do |
349 | 36cb6837 | Klaus Aehlig | logDebug $ jName ++ " not queued; trying to cancel directly" |
350 | 36cb6837 | Klaus Aehlig | cancelJob jid |
351 | 36cb6837 | Klaus Aehlig | Bad s -> return . Ok . showJSON $ (False, s) |
352 | 36cb6837 | Klaus Aehlig | |
353 | 6fdc84ab | Klaus Aehlig | handleCall qlock _ cfg (ArchiveJob jid) = do |
354 | 6fdc84ab | Klaus Aehlig | let archiveFailed = putMVar qlock () >> (return . Ok $ showJSON False) |
355 | 6fdc84ab | Klaus Aehlig | :: IO (ErrorResult JSValue) |
356 | 6fdc84ab | Klaus Aehlig | qDir <- queueDir |
357 | 6fdc84ab | Klaus Aehlig | takeMVar qlock |
358 | 6fdc84ab | Klaus Aehlig | result <- loadJobFromDisk qDir False jid |
359 | 6fdc84ab | Klaus Aehlig | case result of |
360 | 6fdc84ab | Klaus Aehlig | Bad _ -> archiveFailed |
361 | 6fdc84ab | Klaus Aehlig | Ok (job, _) -> if jobFinalized job |
362 | 6fdc84ab | Klaus Aehlig | then do |
363 | 6fdc84ab | Klaus Aehlig | let mcs = Config.getMasterCandidates cfg |
364 | 6fdc84ab | Klaus Aehlig | live = liveJobFile qDir jid |
365 | 6fdc84ab | Klaus Aehlig | archive = archivedJobFile qDir jid |
366 | 0c09ecc2 | Klaus Aehlig | renameResult <- safeRenameFile queueDirPermissions |
367 | 0c09ecc2 | Klaus Aehlig | live archive |
368 | 6fdc84ab | Klaus Aehlig | putMVar qlock () |
369 | 6fdc84ab | Klaus Aehlig | case renameResult of |
370 | 857cbfb1 | Klaus Aehlig | Bad s -> return . Bad . JobQueueError |
371 | 857cbfb1 | Klaus Aehlig | $ "Archiving failed in an unexpected way: " |
372 | 857cbfb1 | Klaus Aehlig | ++ s |
373 | 857cbfb1 | Klaus Aehlig | Ok () -> do |
374 | 6fdc84ab | Klaus Aehlig | _ <- executeRpcCall mcs |
375 | 6fdc84ab | Klaus Aehlig | $ RpcCallJobqueueRename [(live, archive)] |
376 | 6fadcbab | Klaus Aehlig | return . Ok $ showJSON True |
377 | 6fdc84ab | Klaus Aehlig | else archiveFailed |
378 | 6fdc84ab | Klaus Aehlig | |
379 | 658eb2dc | Klaus Aehlig | handleCall qlock _ cfg (AutoArchiveJobs age timeout) = do |
380 | 658eb2dc | Klaus Aehlig | qDir <- queueDir |
381 | ea7032da | Petr Pudlak | resultJids <- getJobIDs [qDir] |
382 | ea7032da | Petr Pudlak | case resultJids of |
383 | ea7032da | Petr Pudlak | Bad s -> return . Bad . JobQueueError $ show s |
384 | ea7032da | Petr Pudlak | Ok jids -> do |
385 | 658eb2dc | Klaus Aehlig | result <- bracket_ (takeMVar qlock) (putMVar qlock ()) |
386 | 658eb2dc | Klaus Aehlig | . archiveJobs cfg age timeout |
387 | 658eb2dc | Klaus Aehlig | $ sortJobIDs jids |
388 | 658eb2dc | Klaus Aehlig | return . Ok $ showJSON result |
389 | 658eb2dc | Klaus Aehlig | |
390 | b5fa2700 | Klaus Aehlig | handleCall _ _ _ op = |
391 | 5183e8be | Iustin Pop | return . Bad $ |
392 | 5183e8be | Iustin Pop | GenericError ("Luxi call '" ++ strOfOp op ++ "' not implemented") |
393 | 25b54de0 | Iustin Pop | |
394 | edcad688 | Petr Pudlak | {-# ANN handleCall "HLint: ignore Too strict if" #-} |
395 | edcad688 | Petr Pudlak | |
396 | 6222b3a3 | Klaus Aehlig | -- | Query the status of a job and return the requested fields |
397 | 6222b3a3 | Klaus Aehlig | -- and the logs newer than the given log number. |
398 | 9131274c | Jose A. Lopes | computeJobUpdate :: ConfigData -> JobId -> [String] -> JSValue |
399 | 6222b3a3 | Klaus Aehlig | -> IO (JSValue, JSValue) |
400 | 6222b3a3 | Klaus Aehlig | computeJobUpdate cfg jid fields prev_log = do |
401 | 6222b3a3 | Klaus Aehlig | let sjid = show $ fromJobId jid |
402 | 6222b3a3 | Klaus Aehlig | logDebug $ "Inspecting fields " ++ show fields ++ " of job " ++ sjid |
403 | 6222b3a3 | Klaus Aehlig | let fromJSArray (JSArray xs) = xs |
404 | 6222b3a3 | Klaus Aehlig | fromJSArray _ = [] |
405 | 6222b3a3 | Klaus Aehlig | let logFilter JSNull (JSArray _) = True |
406 | 6222b3a3 | Klaus Aehlig | logFilter (JSRational _ n) (JSArray (JSRational _ m:_)) = n < m |
407 | 6222b3a3 | Klaus Aehlig | logFilter _ _ = False |
408 | 6222b3a3 | Klaus Aehlig | let filterLogs n logs = JSArray (filter (logFilter n) (logs >>= fromJSArray)) |
409 | 6222b3a3 | Klaus Aehlig | jobQuery <- handleClassicQuery cfg (Qlang.ItemTypeLuxi Qlang.QRJob) |
410 | 6222b3a3 | Klaus Aehlig | [Right . fromIntegral $ fromJobId jid] ("oplog" : fields) False |
411 | 6222b3a3 | Klaus Aehlig | let (rfields, rlogs) = case jobQuery of |
412 | 6222b3a3 | Klaus Aehlig | Ok (JSArray [JSArray (JSArray logs : answer)]) -> |
413 | 6222b3a3 | Klaus Aehlig | (answer, filterLogs prev_log logs) |
414 | 6222b3a3 | Klaus Aehlig | _ -> (map (const JSNull) fields, JSArray []) |
415 | 6222b3a3 | Klaus Aehlig | logDebug $ "Updates for job " ++ sjid ++ " are " ++ encode (rfields, rlogs) |
416 | 6222b3a3 | Klaus Aehlig | return (JSArray rfields, rlogs) |
417 | 6222b3a3 | Klaus Aehlig | |
418 | d79a6502 | Petr Pudlak | |
419 | d79a6502 | Petr Pudlak | type LuxiConfig = (MVar (), JQStatus, ConfigReader) |
420 | d79a6502 | Petr Pudlak | |
421 | d79a6502 | Petr Pudlak | luxiExec |
422 | d79a6502 | Petr Pudlak | :: LuxiConfig |
423 | d79a6502 | Petr Pudlak | -> LuxiOp |
424 | d79a6502 | Petr Pudlak | -> IO (Bool, GenericResult GanetiException JSValue) |
425 | d79a6502 | Petr Pudlak | luxiExec (qlock, qstat, creader) args = do |
426 | 25b54de0 | Iustin Pop | cfg <- creader |
427 | d79a6502 | Petr Pudlak | result <- handleCallWrapper qlock qstat cfg args |
428 | d79a6502 | Petr Pudlak | return (True, result) |
429 | d79a6502 | Petr Pudlak | |
430 | d79a6502 | Petr Pudlak | luxiHandler :: LuxiConfig -> U.Handler LuxiOp JSValue |
431 | d79a6502 | Petr Pudlak | luxiHandler cfg = U.Handler { U.hParse = decodeLuxiCall |
432 | d79a6502 | Petr Pudlak | , U.hInputLogShort = strOfOp |
433 | d79a6502 | Petr Pudlak | , U.hInputLogLong = show |
434 | d79a6502 | Petr Pudlak | , U.hExec = luxiExec cfg |
435 | d79a6502 | Petr Pudlak | } |
436 | d79a6502 | Petr Pudlak | |
437 | 670e954a | Thomas Thrainer | -- | Type alias for prepMain results |
438 | 5e671e0e | Petr Pudlak | type PrepResult = (Server, IORef (Result ConfigData), JQStatus) |
439 | 25b54de0 | Iustin Pop | |
440 | 3695a4e0 | Thomas Thrainer | -- | Check function for luxid. |
441 | 670e954a | Thomas Thrainer | checkMain :: CheckFn () |
442 | 670e954a | Thomas Thrainer | checkMain _ = return $ Right () |
443 | 670e954a | Thomas Thrainer | |
444 | 3695a4e0 | Thomas Thrainer | -- | Prepare function for luxid. |
445 | 670e954a | Thomas Thrainer | prepMain :: PrepFn () PrepResult |
446 | 670e954a | Thomas Thrainer | prepMain _ _ = do |
447 | 670e954a | Thomas Thrainer | socket_path <- Path.defaultQuerySocket |
448 | 0d0ac025 | Iustin Pop | cleanupSocket socket_path |
449 | 73b16ca1 | Iustin Pop | s <- describeError "binding to the Luxi socket" |
450 | d605e261 | Petr Pudlak | Nothing (Just socket_path) $ getLuxiServer True socket_path |
451 | 670e954a | Thomas Thrainer | cref <- newIORef (Bad "Configuration not yet loaded") |
452 | 6046dca9 | Klaus Aehlig | jq <- emptyJQStatus cref |
453 | 5e671e0e | Petr Pudlak | return (s, cref, jq) |
454 | 670e954a | Thomas Thrainer | |
455 | 670e954a | Thomas Thrainer | -- | Main function. |
456 | 670e954a | Thomas Thrainer | main :: MainFn () PrepResult |
457 | 5e671e0e | Petr Pudlak | main _ _ (server, cref, jq) = do |
458 | 670e954a | Thomas Thrainer | initConfigReader id cref |
459 | 670e954a | Thomas Thrainer | let creader = readIORef cref |
460 | b5fa2700 | Klaus Aehlig | initJQScheduler jq |
461 | 9131274c | Jose A. Lopes | |
462 | e5fba493 | Klaus Aehlig | qlockFile <- jobQueueLockFile |
463 | e5fba493 | Klaus Aehlig | lockFile qlockFile >>= exitIfBad "Failed to obtain the job-queue lock" |
464 | e5fba493 | Klaus Aehlig | qlock <- newMVar () |
465 | 4c3f55b8 | Iustin Pop | |
466 | 4c3f55b8 | Iustin Pop | finally |
467 | c7003a76 | Petr Pudlak | (forever $ U.listener (luxiHandler (qlock, jq, creader)) server) |
468 | 5e671e0e | Petr Pudlak | (closeServer server) |