root / src / Ganeti / Query / Server.hs @ e5fba493
History | View | Annotate | Download (12.3 kB)
1 | 25b54de0 | Iustin Pop | {-# LANGUAGE BangPatterns #-} |
---|---|---|---|
2 | 25b54de0 | Iustin Pop | |
3 | d120506c | Agata Murawska | {-| Implementation of the Ganeti Query2 server. |
4 | 25b54de0 | Iustin Pop | |
5 | 25b54de0 | Iustin Pop | -} |
6 | 25b54de0 | Iustin Pop | |
7 | 25b54de0 | Iustin Pop | {- |
8 | 25b54de0 | Iustin Pop | |
9 | 72747d91 | Iustin Pop | Copyright (C) 2012, 2013 Google Inc. |
10 | 25b54de0 | Iustin Pop | |
11 | 25b54de0 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
12 | 25b54de0 | Iustin Pop | it under the terms of the GNU General Public License as published by |
13 | 25b54de0 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
14 | 25b54de0 | Iustin Pop | (at your option) any later version. |
15 | 25b54de0 | Iustin Pop | |
16 | 25b54de0 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
17 | 25b54de0 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | 25b54de0 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 | 25b54de0 | Iustin Pop | General Public License for more details. |
20 | 25b54de0 | Iustin Pop | |
21 | 25b54de0 | Iustin Pop | You should have received a copy of the GNU General Public License |
22 | 25b54de0 | Iustin Pop | along with this program; if not, write to the Free Software |
23 | 25b54de0 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 | 25b54de0 | Iustin Pop | 02110-1301, USA. |
25 | 25b54de0 | Iustin Pop | |
26 | 25b54de0 | Iustin Pop | -} |
27 | 25b54de0 | Iustin Pop | |
28 | 4cab6703 | Iustin Pop | module Ganeti.Query.Server |
29 | 670e954a | Thomas Thrainer | ( main |
30 | 670e954a | Thomas Thrainer | , checkMain |
31 | 670e954a | Thomas Thrainer | , prepMain |
32 | 0d0ac025 | Iustin Pop | ) where |
33 | 25b54de0 | Iustin Pop | |
34 | f2374060 | Iustin Pop | import Control.Applicative |
35 | 25b54de0 | Iustin Pop | import Control.Concurrent |
36 | 25b54de0 | Iustin Pop | import Control.Exception |
37 | e5fba493 | Klaus Aehlig | import Control.Monad (forever, when) |
38 | 25b54de0 | Iustin Pop | import Data.Bits (bitSize) |
39 | c87997d2 | Jose A. Lopes | import qualified Data.Set as Set (toList) |
40 | 670e954a | Thomas Thrainer | import Data.IORef |
41 | 25b54de0 | Iustin Pop | import qualified Network.Socket as S |
42 | 25b54de0 | Iustin Pop | import qualified Text.JSON as J |
43 | 25b54de0 | Iustin Pop | import Text.JSON (showJSON, JSValue(..)) |
44 | 25b54de0 | Iustin Pop | import System.Info (arch) |
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 | 25b54de0 | Iustin Pop | import Ganeti.Logging |
57 | 25b54de0 | Iustin Pop | import Ganeti.Luxi |
58 | 4cab6703 | Iustin Pop | import qualified Ganeti.Query.Language as Qlang |
59 | 1c3231aa | Thomas Thrainer | import qualified Ganeti.Query.Cluster as QCluster |
60 | e5fba493 | Klaus Aehlig | import Ganeti.Path (queueDir, jobQueueLockFile, defaultLuxiSocket) |
61 | 4cbe9bda | Iustin Pop | import Ganeti.Query.Query |
62 | c4e0d065 | Klaus Aehlig | import Ganeti.Query.Filter (makeSimpleFilter) |
63 | 6e94b75c | Jose A. Lopes | import Ganeti.Types |
64 | e5fba493 | Klaus Aehlig | import Ganeti.Utils (lockFile, exitIfBad) |
65 | 25b54de0 | Iustin Pop | |
66 | cd67e337 | Iustin Pop | -- | Helper for classic queries. |
67 | cd67e337 | Iustin Pop | handleClassicQuery :: ConfigData -- ^ Cluster config |
68 | cd67e337 | Iustin Pop | -> Qlang.ItemType -- ^ Query type |
69 | 037762a9 | Iustin Pop | -> [Either String Integer] -- ^ Requested names |
70 | 037762a9 | Iustin Pop | -- (empty means all) |
71 | cd67e337 | Iustin Pop | -> [String] -- ^ Requested fields |
72 | cd67e337 | Iustin Pop | -> Bool -- ^ Whether to do sync queries or not |
73 | 5183e8be | Iustin Pop | -> IO (GenericResult GanetiException JSValue) |
74 | c4e0d065 | Klaus Aehlig | handleClassicQuery _ _ _ _ True = |
75 | 5183e8be | Iustin Pop | return . Bad $ OpPrereqError "Sync queries are not allowed" ECodeInval |
76 | c4e0d065 | Klaus Aehlig | handleClassicQuery cfg qkind names fields _ = do |
77 | c4e0d065 | Klaus Aehlig | let flt = makeSimpleFilter (nameField qkind) names |
78 | cd67e337 | Iustin Pop | qr <- query cfg True (Qlang.Query qkind fields flt) |
79 | cd67e337 | Iustin Pop | return $ showJSON <$> (qr >>= queryCompat) |
80 | cd67e337 | Iustin Pop | |
81 | 25b54de0 | Iustin Pop | -- | Minimal wrapper to handle the missing config case. |
82 | e5fba493 | Klaus Aehlig | handleCallWrapper :: MVar () -> Result ConfigData |
83 | e5fba493 | Klaus Aehlig | -> LuxiOp -> IO (ErrorResult JSValue) |
84 | e5fba493 | Klaus Aehlig | handleCallWrapper _ (Bad msg) _ = |
85 | 5183e8be | Iustin Pop | return . Bad . ConfigurationError $ |
86 | 5183e8be | Iustin Pop | "I do not have access to a valid configuration, cannot\ |
87 | 5183e8be | Iustin Pop | \ process queries: " ++ msg |
88 | e5fba493 | Klaus Aehlig | handleCallWrapper qlock (Ok config) op = handleCall qlock config op |
89 | 25b54de0 | Iustin Pop | |
90 | 25b54de0 | Iustin Pop | -- | Actual luxi operation handler. |
91 | e5fba493 | Klaus Aehlig | handleCall :: MVar () -> ConfigData -> LuxiOp -> IO (ErrorResult JSValue) |
92 | e5fba493 | Klaus Aehlig | handleCall _ cdata QueryClusterInfo = |
93 | 25b54de0 | Iustin Pop | let cluster = configCluster cdata |
94 | 1c3231aa | Thomas Thrainer | master = QCluster.clusterMasterNodeName cdata |
95 | 25b54de0 | Iustin Pop | hypervisors = clusterEnabledHypervisors cluster |
96 | 966e1580 | Helga Velroyen | diskTemplates = clusterEnabledDiskTemplates cluster |
97 | 72747d91 | Iustin Pop | def_hv = case hypervisors of |
98 | 72747d91 | Iustin Pop | x:_ -> showJSON x |
99 | 72747d91 | Iustin Pop | [] -> JSNull |
100 | 25b54de0 | Iustin Pop | bits = show (bitSize (0::Int)) ++ "bits" |
101 | 25b54de0 | Iustin Pop | arch_tuple = [bits, arch] |
102 | 5b11f8db | Iustin Pop | obj = [ ("software_version", showJSON C.releaseVersion) |
103 | 5b11f8db | Iustin Pop | , ("protocol_version", showJSON C.protocolVersion) |
104 | 5b11f8db | Iustin Pop | , ("config_version", showJSON C.configVersion) |
105 | c87997d2 | Jose A. Lopes | , ("os_api_version", showJSON . maximum . |
106 | c87997d2 | Jose A. Lopes | Set.toList . ConstantUtils.unFrozenSet $ |
107 | c87997d2 | Jose A. Lopes | C.osApiVersions) |
108 | 5b11f8db | Iustin Pop | , ("export_version", showJSON C.exportVersion) |
109 | 026f444f | Thomas Thrainer | , ("vcs_version", showJSON C.vcsVersion) |
110 | 5b11f8db | Iustin Pop | , ("architecture", showJSON arch_tuple) |
111 | 25b54de0 | Iustin Pop | , ("name", showJSON $ clusterClusterName cluster) |
112 | 1c3231aa | Thomas Thrainer | , ("master", showJSON (case master of |
113 | 1c3231aa | Thomas Thrainer | Ok name -> name |
114 | 1c3231aa | Thomas Thrainer | _ -> undefined)) |
115 | 72747d91 | Iustin Pop | , ("default_hypervisor", def_hv) |
116 | 5b11f8db | Iustin Pop | , ("enabled_hypervisors", showJSON hypervisors) |
117 | a2160e57 | Iustin Pop | , ("hvparams", showJSON $ clusterHvparams cluster) |
118 | a2160e57 | Iustin Pop | , ("os_hvp", showJSON $ clusterOsHvp cluster) |
119 | 25b54de0 | Iustin Pop | , ("beparams", showJSON $ clusterBeparams cluster) |
120 | 25b54de0 | Iustin Pop | , ("osparams", showJSON $ clusterOsparams cluster) |
121 | 25b54de0 | Iustin Pop | , ("ipolicy", showJSON $ clusterIpolicy cluster) |
122 | 25b54de0 | Iustin Pop | , ("nicparams", showJSON $ clusterNicparams cluster) |
123 | 25b54de0 | Iustin Pop | , ("ndparams", showJSON $ clusterNdparams cluster) |
124 | a2160e57 | Iustin Pop | , ("diskparams", showJSON $ clusterDiskparams cluster) |
125 | 25b54de0 | Iustin Pop | , ("candidate_pool_size", |
126 | 25b54de0 | Iustin Pop | showJSON $ clusterCandidatePoolSize cluster) |
127 | 25b54de0 | Iustin Pop | , ("master_netdev", showJSON $ clusterMasterNetdev cluster) |
128 | 25b54de0 | Iustin Pop | , ("master_netmask", showJSON $ clusterMasterNetmask cluster) |
129 | 25b54de0 | Iustin Pop | , ("use_external_mip_script", |
130 | 25b54de0 | Iustin Pop | showJSON $ clusterUseExternalMipScript cluster) |
131 | 64b0309a | Dimitris Aragiorgis | , ("volume_group_name", |
132 | 64b0309a | Dimitris Aragiorgis | maybe JSNull showJSON (clusterVolumeGroupName cluster)) |
133 | 25b54de0 | Iustin Pop | , ("drbd_usermode_helper", |
134 | 25b54de0 | Iustin Pop | maybe JSNull showJSON (clusterDrbdUsermodeHelper cluster)) |
135 | 25b54de0 | Iustin Pop | , ("file_storage_dir", showJSON $ clusterFileStorageDir cluster) |
136 | 25b54de0 | Iustin Pop | , ("shared_file_storage_dir", |
137 | 25b54de0 | Iustin Pop | showJSON $ clusterSharedFileStorageDir cluster) |
138 | 25b54de0 | Iustin Pop | , ("maintain_node_health", |
139 | 25b54de0 | Iustin Pop | showJSON $ clusterMaintainNodeHealth cluster) |
140 | 25b54de0 | Iustin Pop | , ("ctime", showJSON $ clusterCtime cluster) |
141 | 25b54de0 | Iustin Pop | , ("mtime", showJSON $ clusterMtime cluster) |
142 | 25b54de0 | Iustin Pop | , ("uuid", showJSON $ clusterUuid cluster) |
143 | 25b54de0 | Iustin Pop | , ("tags", showJSON $ clusterTags cluster) |
144 | 25b54de0 | Iustin Pop | , ("uid_pool", showJSON $ clusterUidPool cluster) |
145 | 25b54de0 | Iustin Pop | , ("default_iallocator", |
146 | 25b54de0 | Iustin Pop | showJSON $ clusterDefaultIallocator cluster) |
147 | 25b54de0 | Iustin Pop | , ("reserved_lvs", showJSON $ clusterReservedLvs cluster) |
148 | 25b54de0 | Iustin Pop | , ("primary_ip_version", |
149 | 25b54de0 | Iustin Pop | showJSON . ipFamilyToVersion $ clusterPrimaryIpFamily cluster) |
150 | 7b9ceea7 | Helga Velroyen | , ("prealloc_wipe_disks", |
151 | 7b9ceea7 | Helga Velroyen | showJSON $ clusterPreallocWipeDisks cluster) |
152 | 7b9ceea7 | Helga Velroyen | , ("hidden_os", showJSON $ clusterHiddenOs cluster) |
153 | 7b9ceea7 | Helga Velroyen | , ("blacklisted_os", showJSON $ clusterBlacklistedOs cluster) |
154 | 966e1580 | Helga Velroyen | , ("enabled_disk_templates", showJSON diskTemplates) |
155 | 25b54de0 | Iustin Pop | ] |
156 | 25b54de0 | Iustin Pop | |
157 | 1c3231aa | Thomas Thrainer | in case master of |
158 | 1c3231aa | Thomas Thrainer | Ok _ -> return . Ok . J.makeObj $ obj |
159 | 1c3231aa | Thomas Thrainer | Bad ex -> return $ Bad ex |
160 | 25b54de0 | Iustin Pop | |
161 | e5fba493 | Klaus Aehlig | handleCall _ cfg (QueryTags kind name) = do |
162 | f2374060 | Iustin Pop | let tags = case kind of |
163 | 6e94b75c | Jose A. Lopes | TagKindCluster -> Ok . clusterTags $ configCluster cfg |
164 | 6e94b75c | Jose A. Lopes | TagKindGroup -> groupTags <$> Config.getGroup cfg name |
165 | 6e94b75c | Jose A. Lopes | TagKindNode -> nodeTags <$> Config.getNode cfg name |
166 | 6e94b75c | Jose A. Lopes | TagKindInstance -> instTags <$> Config.getInstance cfg name |
167 | a8633d70 | Jose A. Lopes | TagKindNetwork -> Bad $ OpPrereqError |
168 | a8633d70 | Jose A. Lopes | "Network tag is not allowed" |
169 | a8633d70 | Jose A. Lopes | ECodeInval |
170 | 6e94b75c | Jose A. Lopes | return (J.showJSON <$> tags) |
171 | f2374060 | Iustin Pop | |
172 | e5fba493 | Klaus Aehlig | handleCall _ cfg (Query qkind qfields qfilter) = do |
173 | fa2c927c | Agata Murawska | result <- query cfg True (Qlang.Query qkind qfields qfilter) |
174 | 4cbe9bda | Iustin Pop | return $ J.showJSON <$> result |
175 | 4cbe9bda | Iustin Pop | |
176 | e5fba493 | Klaus Aehlig | handleCall _ _ (QueryFields qkind qfields) = do |
177 | 518023a9 | Iustin Pop | let result = queryFields (Qlang.QueryFields qkind qfields) |
178 | 518023a9 | Iustin Pop | return $ J.showJSON <$> result |
179 | 518023a9 | Iustin Pop | |
180 | e5fba493 | Klaus Aehlig | handleCall _ cfg (QueryNodes names fields lock) = |
181 | 037762a9 | Iustin Pop | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRNode) |
182 | c4e0d065 | Klaus Aehlig | (map Left names) fields lock |
183 | cd67e337 | Iustin Pop | |
184 | e5fba493 | Klaus Aehlig | handleCall _ cfg (QueryGroups names fields lock) = |
185 | 037762a9 | Iustin Pop | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRGroup) |
186 | c4e0d065 | Klaus Aehlig | (map Left names) fields lock |
187 | cd67e337 | Iustin Pop | |
188 | e5fba493 | Klaus Aehlig | handleCall _ cfg (QueryJobs names fields) = |
189 | a7e484c4 | Iustin Pop | handleClassicQuery cfg (Qlang.ItemTypeLuxi Qlang.QRJob) |
190 | c4e0d065 | Klaus Aehlig | (map (Right . fromIntegral . fromJobId) names) fields False |
191 | a7e484c4 | Iustin Pop | |
192 | e5fba493 | Klaus Aehlig | handleCall _ cfg (QueryNetworks names fields lock) = |
193 | 795d035d | Klaus Aehlig | handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRNetwork) |
194 | 795d035d | Klaus Aehlig | (map Left names) fields lock |
195 | 795d035d | Klaus Aehlig | |
196 | e5fba493 | Klaus Aehlig | handleCall qlock cfg (SubmitJobToDrainedQueue ops) = |
197 | e5fba493 | Klaus Aehlig | do |
198 | e5fba493 | Klaus Aehlig | jobid <- allocateJobId (Config.getMasterCandidates cfg) qlock |
199 | e5fba493 | Klaus Aehlig | case jobid of |
200 | e5fba493 | Klaus Aehlig | Bad s -> return . Bad . GenericError $ s |
201 | e5fba493 | Klaus Aehlig | Ok jid -> do |
202 | e5fba493 | Klaus Aehlig | qDir <- queueDir |
203 | e5fba493 | Klaus Aehlig | job <- queuedJobFromOpCodes jid ops |
204 | e5fba493 | Klaus Aehlig | write_result <- writeJobToDisk qDir job |
205 | e5fba493 | Klaus Aehlig | case write_result of |
206 | e5fba493 | Klaus Aehlig | Bad s -> return . Bad . GenericError $ s |
207 | e5fba493 | Klaus Aehlig | Ok () -> do |
208 | e5fba493 | Klaus Aehlig | socketpath <- defaultLuxiSocket |
209 | e5fba493 | Klaus Aehlig | client <- getClient socketpath |
210 | e5fba493 | Klaus Aehlig | pickupResult <- callMethod (PickupJob jid) client |
211 | e5fba493 | Klaus Aehlig | closeClient client |
212 | e5fba493 | Klaus Aehlig | case pickupResult of |
213 | e5fba493 | Klaus Aehlig | Ok _ -> return () |
214 | e5fba493 | Klaus Aehlig | Bad e -> logWarning $ "Failded to notify masterd: " ++ show e |
215 | e5fba493 | Klaus Aehlig | return . Ok . showJSON . fromJobId $ jid |
216 | e5fba493 | Klaus Aehlig | |
217 | e5fba493 | Klaus Aehlig | handleCall qlock cfg (SubmitJob ops) = |
218 | e5fba493 | Klaus Aehlig | do |
219 | e5fba493 | Klaus Aehlig | open <- isQueueOpen |
220 | e5fba493 | Klaus Aehlig | if not open |
221 | e5fba493 | Klaus Aehlig | then return . Bad . GenericError $ "Queue drained" |
222 | e5fba493 | Klaus Aehlig | else handleCall qlock cfg (SubmitJobToDrainedQueue ops) |
223 | e5fba493 | Klaus Aehlig | |
224 | e5fba493 | Klaus Aehlig | handleCall _ _ op = |
225 | 5183e8be | Iustin Pop | return . Bad $ |
226 | 5183e8be | Iustin Pop | GenericError ("Luxi call '" ++ strOfOp op ++ "' not implemented") |
227 | 25b54de0 | Iustin Pop | |
228 | 25b54de0 | Iustin Pop | -- | Given a decoded luxi request, executes it and sends the luxi |
229 | 25b54de0 | Iustin Pop | -- response back to the client. |
230 | e5fba493 | Klaus Aehlig | handleClientMsg :: MVar () -> Client -> ConfigReader -> LuxiOp -> IO Bool |
231 | e5fba493 | Klaus Aehlig | handleClientMsg qlock client creader args = do |
232 | 25b54de0 | Iustin Pop | cfg <- creader |
233 | 25b54de0 | Iustin Pop | logDebug $ "Request: " ++ show args |
234 | e5fba493 | Klaus Aehlig | call_result <- handleCallWrapper qlock cfg args |
235 | 25b54de0 | Iustin Pop | (!status, !rval) <- |
236 | 25b54de0 | Iustin Pop | case call_result of |
237 | 9abbb084 | Iustin Pop | Bad err -> do |
238 | 3e0c2a24 | Klaus Aehlig | logWarning $ "Failed to execute request " ++ show args ++ ": " |
239 | 3e0c2a24 | Klaus Aehlig | ++ show err |
240 | 5183e8be | Iustin Pop | return (False, showJSON err) |
241 | 25b54de0 | Iustin Pop | Ok result -> do |
242 | f74b88fa | Iustin Pop | -- only log the first 2,000 chars of the result |
243 | f74b88fa | Iustin Pop | logDebug $ "Result (truncated): " ++ take 2000 (J.encode result) |
244 | 3e0c2a24 | Klaus Aehlig | logInfo $ "Successfully handled " ++ strOfOp args |
245 | 25b54de0 | Iustin Pop | return (True, result) |
246 | 25b54de0 | Iustin Pop | sendMsg client $ buildResponse status rval |
247 | 25b54de0 | Iustin Pop | return True |
248 | 25b54de0 | Iustin Pop | |
249 | 25b54de0 | Iustin Pop | -- | Handles one iteration of the client protocol: receives message, |
250 | 3e02cd3c | Michele Tartara | -- checks it for validity and decodes it, returns response. |
251 | e5fba493 | Klaus Aehlig | handleClient :: MVar () -> Client -> ConfigReader -> IO Bool |
252 | e5fba493 | Klaus Aehlig | handleClient qlock client creader = do |
253 | 25b54de0 | Iustin Pop | !msg <- recvMsgExt client |
254 | 385d4574 | Klaus Aehlig | logDebug $ "Received message: " ++ show msg |
255 | 25b54de0 | Iustin Pop | case msg of |
256 | 25b54de0 | Iustin Pop | RecvConnClosed -> logDebug "Connection closed" >> return False |
257 | 25b54de0 | Iustin Pop | RecvError err -> logWarning ("Error during message receiving: " ++ err) >> |
258 | 25b54de0 | Iustin Pop | return False |
259 | 25b54de0 | Iustin Pop | RecvOk payload -> |
260 | 25b54de0 | Iustin Pop | case validateCall payload >>= decodeCall of |
261 | 9abbb084 | Iustin Pop | Bad err -> do |
262 | 9abbb084 | Iustin Pop | let errmsg = "Failed to parse request: " ++ err |
263 | 9abbb084 | Iustin Pop | logWarning errmsg |
264 | 9abbb084 | Iustin Pop | sendMsg client $ buildResponse False (showJSON errmsg) |
265 | 9abbb084 | Iustin Pop | return False |
266 | e5fba493 | Klaus Aehlig | Ok args -> handleClientMsg qlock client creader args |
267 | 25b54de0 | Iustin Pop | |
268 | 25b54de0 | Iustin Pop | -- | Main client loop: runs one loop of 'handleClient', and if that |
269 | cb44e3db | Helga Velroyen | -- doesn't report a finished (closed) connection, restarts itself. |
270 | e5fba493 | Klaus Aehlig | clientLoop :: MVar () -> Client -> ConfigReader -> IO () |
271 | e5fba493 | Klaus Aehlig | clientLoop qlock client creader = do |
272 | e5fba493 | Klaus Aehlig | result <- handleClient qlock client creader |
273 | 25b54de0 | Iustin Pop | if result |
274 | e5fba493 | Klaus Aehlig | then clientLoop qlock client creader |
275 | 25b54de0 | Iustin Pop | else closeClient client |
276 | 25b54de0 | Iustin Pop | |
277 | 670e954a | Thomas Thrainer | -- | Main listener loop: accepts clients, forks an I/O thread to handle |
278 | 670e954a | Thomas Thrainer | -- that client. |
279 | e5fba493 | Klaus Aehlig | listener :: MVar () -> ConfigReader -> S.Socket -> IO () |
280 | e5fba493 | Klaus Aehlig | listener qlock creader socket = do |
281 | 25b54de0 | Iustin Pop | client <- acceptClient socket |
282 | e5fba493 | Klaus Aehlig | _ <- forkIO $ clientLoop qlock client creader |
283 | 670e954a | Thomas Thrainer | return () |
284 | 25b54de0 | Iustin Pop | |
285 | 670e954a | Thomas Thrainer | -- | Type alias for prepMain results |
286 | 670e954a | Thomas Thrainer | type PrepResult = (FilePath, S.Socket, IORef (Result ConfigData)) |
287 | 25b54de0 | Iustin Pop | |
288 | 3695a4e0 | Thomas Thrainer | -- | Check function for luxid. |
289 | 670e954a | Thomas Thrainer | checkMain :: CheckFn () |
290 | 670e954a | Thomas Thrainer | checkMain _ = return $ Right () |
291 | 670e954a | Thomas Thrainer | |
292 | 3695a4e0 | Thomas Thrainer | -- | Prepare function for luxid. |
293 | 670e954a | Thomas Thrainer | prepMain :: PrepFn () PrepResult |
294 | 670e954a | Thomas Thrainer | prepMain _ _ = do |
295 | 670e954a | Thomas Thrainer | socket_path <- Path.defaultQuerySocket |
296 | 0d0ac025 | Iustin Pop | cleanupSocket socket_path |
297 | 73b16ca1 | Iustin Pop | s <- describeError "binding to the Luxi socket" |
298 | e455a3e8 | Michele Tartara | Nothing (Just socket_path) $ getServer True socket_path |
299 | 670e954a | Thomas Thrainer | cref <- newIORef (Bad "Configuration not yet loaded") |
300 | 670e954a | Thomas Thrainer | return (socket_path, s, cref) |
301 | 670e954a | Thomas Thrainer | |
302 | 670e954a | Thomas Thrainer | -- | Main function. |
303 | 670e954a | Thomas Thrainer | main :: MainFn () PrepResult |
304 | 670e954a | Thomas Thrainer | main _ _ (socket_path, server, cref) = do |
305 | 670e954a | Thomas Thrainer | initConfigReader id cref |
306 | 670e954a | Thomas Thrainer | let creader = readIORef cref |
307 | e5fba493 | Klaus Aehlig | |
308 | e5fba493 | Klaus Aehlig | qlockFile <- jobQueueLockFile |
309 | e5fba493 | Klaus Aehlig | lockFile qlockFile >>= exitIfBad "Failed to obtain the job-queue lock" |
310 | e5fba493 | Klaus Aehlig | qlock <- newMVar () |
311 | 4c3f55b8 | Iustin Pop | |
312 | 4c3f55b8 | Iustin Pop | finally |
313 | e5fba493 | Klaus Aehlig | (forever $ listener qlock creader server) |
314 | 4c3f55b8 | Iustin Pop | (closeServer socket_path server) |