Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Confd / Server.hs @ 11e90588

History | View | Annotate | Download (10.5 kB)

1 358a0a8f Iustin Pop
{-| Implementation of the Ganeti confd server functionality.
2 358a0a8f Iustin Pop
3 358a0a8f Iustin Pop
-}
4 358a0a8f Iustin Pop
5 358a0a8f Iustin Pop
{-
6 358a0a8f Iustin Pop
7 3190ad64 Iustin Pop
Copyright (C) 2011, 2012, 2013 Google Inc.
8 358a0a8f Iustin Pop
9 358a0a8f Iustin Pop
This program is free software; you can redistribute it and/or modify
10 358a0a8f Iustin Pop
it under the terms of the GNU General Public License as published by
11 358a0a8f Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 358a0a8f Iustin Pop
(at your option) any later version.
13 358a0a8f Iustin Pop
14 358a0a8f Iustin Pop
This program is distributed in the hope that it will be useful, but
15 358a0a8f Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 358a0a8f Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 358a0a8f Iustin Pop
General Public License for more details.
18 358a0a8f Iustin Pop
19 358a0a8f Iustin Pop
You should have received a copy of the GNU General Public License
20 358a0a8f Iustin Pop
along with this program; if not, write to the Free Software
21 358a0a8f Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 358a0a8f Iustin Pop
02110-1301, USA.
23 358a0a8f Iustin Pop
24 358a0a8f Iustin Pop
-}
25 358a0a8f Iustin Pop
26 358a0a8f Iustin Pop
module Ganeti.Confd.Server
27 358a0a8f Iustin Pop
  ( main
28 2ac2e420 Iustin Pop
  , checkMain
29 2ac2e420 Iustin Pop
  , prepMain
30 358a0a8f Iustin Pop
  ) where
31 358a0a8f Iustin Pop
32 358a0a8f Iustin Pop
import Control.Concurrent
33 218e3b0f Thomas Thrainer
import Control.Monad (forever, liftM)
34 358a0a8f Iustin Pop
import Data.IORef
35 358a0a8f Iustin Pop
import Data.List
36 358a0a8f Iustin Pop
import qualified Data.Map as M
37 2cdaf225 Iustin Pop
import Data.Maybe (fromMaybe)
38 358a0a8f Iustin Pop
import qualified Network.Socket as S
39 ef3de7b0 Iustin Pop
import System.Exit
40 ef3de7b0 Iustin Pop
import System.IO
41 358a0a8f Iustin Pop
import qualified Text.JSON as J
42 358a0a8f Iustin Pop
43 4cd79ca8 Iustin Pop
import Ganeti.BasicTypes
44 5183e8be Iustin Pop
import Ganeti.Errors
45 358a0a8f Iustin Pop
import Ganeti.Daemon
46 f3baf5ef Iustin Pop
import Ganeti.JSON
47 358a0a8f Iustin Pop
import Ganeti.Objects
48 cdc2392b Iustin Pop
import Ganeti.Confd.Types
49 62377cf5 Iustin Pop
import Ganeti.Confd.Utils
50 358a0a8f Iustin Pop
import Ganeti.Config
51 218e3b0f Thomas Thrainer
import Ganeti.ConfigReader
52 358a0a8f Iustin Pop
import Ganeti.Hash
53 358a0a8f Iustin Pop
import Ganeti.Logging
54 358a0a8f Iustin Pop
import qualified Ganeti.Constants as C
55 ea626b33 Iustin Pop
import Ganeti.Utils
56 358a0a8f Iustin Pop
57 358a0a8f Iustin Pop
-- * Types and constants definitions
58 358a0a8f Iustin Pop
59 358a0a8f Iustin Pop
-- | What we store as configuration.
60 358a0a8f Iustin Pop
type CRef = IORef (Result (ConfigData, LinkIpMap))
61 358a0a8f Iustin Pop
62 358a0a8f Iustin Pop
-- | A small type alias for readability.
63 358a0a8f Iustin Pop
type StatusAnswer = (ConfdReplyStatus, J.JSValue)
64 358a0a8f Iustin Pop
65 358a0a8f Iustin Pop
-- | Unknown entry standard response.
66 358a0a8f Iustin Pop
queryUnknownEntry :: StatusAnswer
67 358a0a8f Iustin Pop
queryUnknownEntry = (ReplyStatusError, J.showJSON ConfdErrorUnknownEntry)
68 358a0a8f Iustin Pop
69 358a0a8f Iustin Pop
{- not used yet
70 358a0a8f Iustin Pop
-- | Internal error standard response.
71 358a0a8f Iustin Pop
queryInternalError :: StatusAnswer
72 358a0a8f Iustin Pop
queryInternalError = (ReplyStatusError, J.showJSON ConfdErrorInternal)
73 358a0a8f Iustin Pop
-}
74 358a0a8f Iustin Pop
75 358a0a8f Iustin Pop
-- | Argument error standard response.
76 358a0a8f Iustin Pop
queryArgumentError :: StatusAnswer
77 358a0a8f Iustin Pop
queryArgumentError = (ReplyStatusError, J.showJSON ConfdErrorArgument)
78 358a0a8f Iustin Pop
79 5183e8be Iustin Pop
-- | Converter from specific error to a string format.
80 5183e8be Iustin Pop
gntErrorToResult :: ErrorResult a -> Result a
81 5183e8be Iustin Pop
gntErrorToResult (Bad err) = Bad (show err)
82 5183e8be Iustin Pop
gntErrorToResult (Ok x) = Ok x
83 5183e8be Iustin Pop
84 358a0a8f Iustin Pop
-- * Confd base functionality
85 358a0a8f Iustin Pop
86 358a0a8f Iustin Pop
-- | Computes the node role.
87 358a0a8f Iustin Pop
nodeRole :: ConfigData -> String -> Result ConfdNodeRole
88 358a0a8f Iustin Pop
nodeRole cfg name =
89 358a0a8f Iustin Pop
  let cmaster = clusterMasterNode . configCluster $ cfg
90 84835174 Iustin Pop
      mnode = M.lookup name . fromContainer . configNodes $ cfg
91 358a0a8f Iustin Pop
  in case mnode of
92 358a0a8f Iustin Pop
       Nothing -> Bad "Node not found"
93 358a0a8f Iustin Pop
       Just node | cmaster == name -> Ok NodeRoleMaster
94 358a0a8f Iustin Pop
                 | nodeDrained node -> Ok NodeRoleDrained
95 358a0a8f Iustin Pop
                 | nodeOffline node -> Ok NodeRoleOffline
96 358a0a8f Iustin Pop
                 | nodeMasterCandidate node -> Ok NodeRoleCandidate
97 358a0a8f Iustin Pop
       _ -> Ok NodeRoleRegular
98 358a0a8f Iustin Pop
99 358a0a8f Iustin Pop
-- | Does an instance ip -> instance -> primary node -> primary ip
100 358a0a8f Iustin Pop
-- transformation.
101 358a0a8f Iustin Pop
getNodePipByInstanceIp :: ConfigData
102 358a0a8f Iustin Pop
                       -> LinkIpMap
103 358a0a8f Iustin Pop
                       -> String
104 358a0a8f Iustin Pop
                       -> String
105 358a0a8f Iustin Pop
                       -> StatusAnswer
106 358a0a8f Iustin Pop
getNodePipByInstanceIp cfg linkipmap link instip =
107 358a0a8f Iustin Pop
  case M.lookup instip (M.findWithDefault M.empty link linkipmap) of
108 358a0a8f Iustin Pop
    Nothing -> queryUnknownEntry
109 358a0a8f Iustin Pop
    Just instname ->
110 358a0a8f Iustin Pop
      case getInstPrimaryNode cfg instname of
111 358a0a8f Iustin Pop
        Bad _ -> queryUnknownEntry -- either instance or node not found
112 358a0a8f Iustin Pop
        Ok node -> (ReplyStatusOk, J.showJSON (nodePrimaryIp node))
113 358a0a8f Iustin Pop
114 358a0a8f Iustin Pop
-- | Builds the response to a given query.
115 358a0a8f Iustin Pop
buildResponse :: (ConfigData, LinkIpMap) -> ConfdRequest -> Result StatusAnswer
116 358a0a8f Iustin Pop
buildResponse (cfg, _) (ConfdRequest { confdRqType = ReqPing }) =
117 358a0a8f Iustin Pop
  return (ReplyStatusOk, J.showJSON (configVersion cfg))
118 358a0a8f Iustin Pop
119 358a0a8f Iustin Pop
buildResponse cdata req@(ConfdRequest { confdRqType = ReqClusterMaster }) =
120 358a0a8f Iustin Pop
  case confdRqQuery req of
121 358a0a8f Iustin Pop
    EmptyQuery -> return (ReplyStatusOk, J.showJSON master_name)
122 358a0a8f Iustin Pop
    PlainQuery _ -> return queryArgumentError
123 358a0a8f Iustin Pop
    DictQuery reqq -> do
124 5183e8be Iustin Pop
      mnode <- gntErrorToResult $ getNode cfg master_name
125 5183e8be Iustin Pop
      let fvals = map (\field -> case field of
126 5183e8be Iustin Pop
                                   ReqFieldName -> master_name
127 5183e8be Iustin Pop
                                   ReqFieldIp -> clusterMasterIp cluster
128 5183e8be Iustin Pop
                                   ReqFieldMNodePip -> nodePrimaryIp mnode
129 5183e8be Iustin Pop
                      ) (confdReqQFields reqq)
130 358a0a8f Iustin Pop
      return (ReplyStatusOk, J.showJSON fvals)
131 358a0a8f Iustin Pop
    where master_name = clusterMasterNode cluster
132 358a0a8f Iustin Pop
          cluster = configCluster cfg
133 358a0a8f Iustin Pop
          cfg = fst cdata
134 358a0a8f Iustin Pop
135 358a0a8f Iustin Pop
buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeRoleByName }) = do
136 358a0a8f Iustin Pop
  node_name <- case confdRqQuery req of
137 358a0a8f Iustin Pop
                 PlainQuery str -> return str
138 358a0a8f Iustin Pop
                 _ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
139 358a0a8f Iustin Pop
  role <- nodeRole (fst cdata) node_name
140 358a0a8f Iustin Pop
  return (ReplyStatusOk, J.showJSON role)
141 358a0a8f Iustin Pop
142 358a0a8f Iustin Pop
buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipList }) =
143 358a0a8f Iustin Pop
  -- note: we use foldlWithKey because that's present accross more
144 358a0a8f Iustin Pop
  -- versions of the library
145 358a0a8f Iustin Pop
  return (ReplyStatusOk, J.showJSON $
146 358a0a8f Iustin Pop
          M.foldlWithKey (\accu _ n -> nodePrimaryIp n:accu) []
147 84835174 Iustin Pop
          (fromContainer . configNodes . fst $ cdata))
148 358a0a8f Iustin Pop
149 358a0a8f Iustin Pop
buildResponse cdata (ConfdRequest { confdRqType = ReqMcPipList }) =
150 358a0a8f Iustin Pop
  -- note: we use foldlWithKey because that's present accross more
151 358a0a8f Iustin Pop
  -- versions of the library
152 358a0a8f Iustin Pop
  return (ReplyStatusOk, J.showJSON $
153 358a0a8f Iustin Pop
          M.foldlWithKey (\accu _ n -> if nodeMasterCandidate n
154 358a0a8f Iustin Pop
                                         then nodePrimaryIp n:accu
155 358a0a8f Iustin Pop
                                         else accu) []
156 84835174 Iustin Pop
          (fromContainer . configNodes . fst $ cdata))
157 358a0a8f Iustin Pop
158 358a0a8f Iustin Pop
buildResponse (cfg, linkipmap)
159 358a0a8f Iustin Pop
              req@(ConfdRequest { confdRqType = ReqInstIpsList }) = do
160 358a0a8f Iustin Pop
  link <- case confdRqQuery req of
161 358a0a8f Iustin Pop
            PlainQuery str -> return str
162 358a0a8f Iustin Pop
            EmptyQuery -> return (getDefaultNicLink cfg)
163 358a0a8f Iustin Pop
            _ -> fail "Invalid query type"
164 358a0a8f Iustin Pop
  return (ReplyStatusOk, J.showJSON $ getInstancesIpByLink linkipmap link)
165 358a0a8f Iustin Pop
166 358a0a8f Iustin Pop
buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipByInstPip
167 358a0a8f Iustin Pop
                                  , confdRqQuery = DictQuery query}) =
168 358a0a8f Iustin Pop
  let (cfg, linkipmap) = cdata
169 2cdaf225 Iustin Pop
      link = fromMaybe (getDefaultNicLink cfg) (confdReqQLink query)
170 358a0a8f Iustin Pop
  in case confdReqQIp query of
171 358a0a8f Iustin Pop
       Just ip -> return $ getNodePipByInstanceIp cfg linkipmap link ip
172 358a0a8f Iustin Pop
       Nothing -> return (ReplyStatusOk,
173 358a0a8f Iustin Pop
                          J.showJSON $
174 358a0a8f Iustin Pop
                           map (getNodePipByInstanceIp cfg linkipmap link)
175 358a0a8f Iustin Pop
                           (confdReqQIpList query))
176 358a0a8f Iustin Pop
177 358a0a8f Iustin Pop
buildResponse _ (ConfdRequest { confdRqType = ReqNodePipByInstPip }) =
178 358a0a8f Iustin Pop
  return queryArgumentError
179 358a0a8f Iustin Pop
180 d81ec8b7 Iustin Pop
buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do
181 d81ec8b7 Iustin Pop
  let cfg = fst cdata
182 d81ec8b7 Iustin Pop
  node_name <- case confdRqQuery req of
183 d81ec8b7 Iustin Pop
                 PlainQuery str -> return str
184 d81ec8b7 Iustin Pop
                 _ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
185 5183e8be Iustin Pop
  node <- gntErrorToResult $ getNode cfg node_name
186 d81ec8b7 Iustin Pop
  let minors = concatMap (getInstMinorsForNode (nodeName node)) .
187 84835174 Iustin Pop
               M.elems . fromContainer . configInstances $ cfg
188 d81ec8b7 Iustin Pop
      encoded = [J.JSArray [J.showJSON a, J.showJSON b, J.showJSON c,
189 d81ec8b7 Iustin Pop
                             J.showJSON d, J.showJSON e, J.showJSON f] |
190 d81ec8b7 Iustin Pop
                 (a, b, c, d, e, f) <- minors]
191 d81ec8b7 Iustin Pop
  return (ReplyStatusOk, J.showJSON encoded)
192 d81ec8b7 Iustin Pop
193 332a83ca Michele Tartara
buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeInstances }) = do
194 332a83ca Michele Tartara
  let cfg = fst cdata
195 332a83ca Michele Tartara
  node_name <- case confdRqQuery req of
196 332a83ca Michele Tartara
                PlainQuery str -> return str
197 332a83ca Michele Tartara
                _ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
198 332a83ca Michele Tartara
  let instances = getNodeInstances cfg node_name
199 332a83ca Michele Tartara
  return (ReplyStatusOk, J.showJSON instances)
200 332a83ca Michele Tartara
201 358a0a8f Iustin Pop
-- | Creates a ConfdReply from a given answer.
202 358a0a8f Iustin Pop
serializeResponse :: Result StatusAnswer -> ConfdReply
203 358a0a8f Iustin Pop
serializeResponse r =
204 358a0a8f Iustin Pop
    let (status, result) = case r of
205 358a0a8f Iustin Pop
                    Bad err -> (ReplyStatusError, J.showJSON err)
206 358a0a8f Iustin Pop
                    Ok (code, val) -> (code, val)
207 358a0a8f Iustin Pop
    in ConfdReply { confdReplyProtocol = 1
208 358a0a8f Iustin Pop
                  , confdReplyStatus   = status
209 358a0a8f Iustin Pop
                  , confdReplyAnswer   = result
210 358a0a8f Iustin Pop
                  , confdReplySerial   = 0 }
211 358a0a8f Iustin Pop
212 358a0a8f Iustin Pop
-- ** Client input/output handlers
213 358a0a8f Iustin Pop
214 358a0a8f Iustin Pop
-- | Main loop for a given client.
215 358a0a8f Iustin Pop
responder :: CRef -> S.Socket -> HashKey -> String -> S.SockAddr -> IO ()
216 358a0a8f Iustin Pop
responder cfgref socket hmac msg peer = do
217 358a0a8f Iustin Pop
  ctime <- getCurrentTime
218 497f5cbf Michele Tartara
  case parseRequest hmac msg ctime of
219 358a0a8f Iustin Pop
    Ok (origmsg, rq) -> do
220 ea626b33 Iustin Pop
              logDebug $ "Processing request: " ++ rStripSpace origmsg
221 358a0a8f Iustin Pop
              mcfg <- readIORef cfgref
222 358a0a8f Iustin Pop
              let response = respondInner mcfg hmac rq
223 358a0a8f Iustin Pop
              _ <- S.sendTo socket response peer
224 358a0a8f Iustin Pop
              return ()
225 358a0a8f Iustin Pop
    Bad err -> logInfo $ "Failed to parse incoming message: " ++ err
226 358a0a8f Iustin Pop
  return ()
227 358a0a8f Iustin Pop
228 358a0a8f Iustin Pop
-- | Inner helper function for a given client. This generates the
229 358a0a8f Iustin Pop
-- final encoded message (as a string), ready to be sent out to the
230 358a0a8f Iustin Pop
-- client.
231 358a0a8f Iustin Pop
respondInner :: Result (ConfigData, LinkIpMap) -> HashKey
232 358a0a8f Iustin Pop
             -> ConfdRequest -> String
233 358a0a8f Iustin Pop
respondInner cfg hmac rq =
234 358a0a8f Iustin Pop
  let rsalt = confdRqRsalt rq
235 358a0a8f Iustin Pop
      innermsg = serializeResponse (cfg >>= flip buildResponse rq)
236 358a0a8f Iustin Pop
      innerserialised = J.encodeStrict innermsg
237 358a0a8f Iustin Pop
      outermsg = signMessage hmac rsalt innerserialised
238 358a0a8f Iustin Pop
      outerserialised = confdMagicFourcc ++ J.encodeStrict outermsg
239 358a0a8f Iustin Pop
  in outerserialised
240 358a0a8f Iustin Pop
241 358a0a8f Iustin Pop
-- | Main listener loop.
242 358a0a8f Iustin Pop
listener :: S.Socket -> HashKey
243 358a0a8f Iustin Pop
         -> (S.Socket -> HashKey -> String -> S.SockAddr -> IO ())
244 358a0a8f Iustin Pop
         -> IO ()
245 358a0a8f Iustin Pop
listener s hmac resp = do
246 358a0a8f Iustin Pop
  (msg, _, peer) <- S.recvFrom s 4096
247 358a0a8f Iustin Pop
  if confdMagicFourcc `isPrefixOf` msg
248 5b11f8db Iustin Pop
    then forkIO (resp s hmac (drop 4 msg) peer) >> return ()
249 358a0a8f Iustin Pop
    else logDebug "Invalid magic code!" >> return ()
250 358a0a8f Iustin Pop
  return ()
251 358a0a8f Iustin Pop
252 ef3de7b0 Iustin Pop
-- | Type alias for prepMain results
253 670e954a Thomas Thrainer
type PrepResult = (S.Socket, IORef (Result (ConfigData, LinkIpMap)))
254 ef3de7b0 Iustin Pop
255 2ac2e420 Iustin Pop
-- | Check function for confd.
256 ef3de7b0 Iustin Pop
checkMain :: CheckFn (S.Family, S.SockAddr)
257 ef3de7b0 Iustin Pop
checkMain opts = do
258 ef3de7b0 Iustin Pop
  parseresult <- parseAddress opts C.defaultConfdPort
259 ef3de7b0 Iustin Pop
  case parseresult of
260 ef3de7b0 Iustin Pop
    Bad msg -> do
261 ef3de7b0 Iustin Pop
      hPutStrLn stderr $ "parsing bind address: " ++ msg
262 ef3de7b0 Iustin Pop
      return . Left $ ExitFailure 1
263 ef3de7b0 Iustin Pop
    Ok v -> return $ Right v
264 2ac2e420 Iustin Pop
265 2ac2e420 Iustin Pop
-- | Prepare function for confd.
266 ef3de7b0 Iustin Pop
prepMain :: PrepFn (S.Family, S.SockAddr) PrepResult
267 ef3de7b0 Iustin Pop
prepMain _ (af_family, bindaddr) = do
268 19cff311 Iustin Pop
  s <- S.socket af_family S.Datagram S.defaultProtocol
269 19cff311 Iustin Pop
  S.bindSocket s bindaddr
270 358a0a8f Iustin Pop
  cref <- newIORef (Bad "Configuration not yet loaded")
271 670e954a Thomas Thrainer
  return (s, cref)
272 ef3de7b0 Iustin Pop
273 ef3de7b0 Iustin Pop
-- | Main function.
274 ef3de7b0 Iustin Pop
main :: MainFn (S.Family, S.SockAddr) PrepResult
275 670e954a Thomas Thrainer
main _ _ (s, cref) = do
276 218e3b0f Thomas Thrainer
  let cfg_transform :: Result ConfigData -> Result (ConfigData, LinkIpMap)
277 218e3b0f Thomas Thrainer
      cfg_transform = liftM (\cfg -> (cfg, buildLinkIpInstnameMap cfg))
278 218e3b0f Thomas Thrainer
  initConfigReader cfg_transform cref
279 218e3b0f Thomas Thrainer
280 c62df702 Iustin Pop
  hmac <- getClusterHmac
281 670e954a Thomas Thrainer
  -- enter the responder loop
282 358a0a8f Iustin Pop
  forever $ listener s hmac (responder cref)