Commit 62377cf5 authored by Iustin Pop's avatar Iustin Pop

Reduce some more code duplication and split code

The Qlang module defines ResultStatus, but it was already defined in
Ganeti/Luxi.hs; let's remove the duplicate definition from there since
the proper place is in the newer module.

Also, in order to ease testing, we split some confd functions into a
separate module; this can be imported easily into QC for testing.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 0384c457
......@@ -404,6 +404,7 @@ HS_LIB_SRCS = \
htools/Ganeti/BasicTypes.hs \
htools/Ganeti/Confd.hs \
htools/Ganeti/Confd/Server.hs \
htools/Ganeti/Confd/Utils.hs \
htools/Ganeti/Config.hs \
htools/Ganeti/Daemon.hs \
htools/Ganeti/Hash.hs \
......
......@@ -32,7 +32,6 @@ module Ganeti.Confd.Server
import Control.Concurrent
import Control.Exception
import Control.Monad (forever, liftM, when)
import qualified Data.ByteString as B
import Data.IORef
import Data.List
import qualified Data.Map as M
......@@ -51,6 +50,7 @@ import Ganeti.HTools.Types
import Ganeti.HTools.Utils
import Ganeti.Objects
import Ganeti.Confd
import Ganeti.Confd.Utils
import Ganeti.Config
import Ganeti.Hash
import Ganeti.Logging
......@@ -131,10 +131,6 @@ getCurrentTime = do
-- * Confd base functionality
-- | Returns the HMAC key.
getClusterHmac :: IO HashKey
getClusterHmac = fmap B.unpack $ B.readFile C.confdHmacKey
-- | Computes the node role.
nodeRole :: ConfigData -> String -> Result ConfdNodeRole
nodeRole cfg name =
......@@ -242,15 +238,6 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do
(a, b, c, d, e, f) <- minors]
return (ReplyStatusOk, J.showJSON encoded)
-- | Parses a signed request.
parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest)
parseRequest key str = do
(SignedMessage hmac msg salt) <- fromJResult "parsing request" $ J.decode str
req <- if verifyMac key (Just salt) msg hmac
then fromJResult "parsing message" $ J.decode msg
else Bad "HMAC verification failed"
return (salt, msg, req)
-- | Creates a ConfdReply from a given answer.
serializeResponse :: Result StatusAnswer -> ConfdReply
serializeResponse r =
......@@ -262,15 +249,6 @@ serializeResponse r =
, confdReplyAnswer = result
, confdReplySerial = 0 }
-- | Signs a message with a given key and salt.
signMessage :: HashKey -> String -> String -> SignedMessage
signMessage key salt msg =
SignedMessage { signedMsgMsg = msg
, signedMsgSalt = salt
, signedMsgHmac = hmac
}
where hmac = computeMac key (Just salt) msg
-- * Configuration handling
-- ** Helper functions
......@@ -483,17 +461,6 @@ responder cfgref socket hmac msg peer = do
Bad err -> logInfo $ "Failed to parse incoming message: " ++ err
return ()
-- | Mesage parsing. This can either result in a good, valid message,
-- or fail in the Result monad.
parseMessage :: HashKey -> String -> Integer
-> Result (String, ConfdRequest)
parseMessage hmac msg curtime = do
(salt, origmsg, request) <- parseRequest hmac msg
ts <- tryRead "Parsing timestamp" salt::Result Integer
if (abs (ts - curtime) > (fromIntegral C.confdMaxClockSkew))
then fail "Too old/too new timestamp or clock skew"
else return (origmsg, request)
-- | Inner helper function for a given client. This generates the
-- final encoded message (as a string), ready to be sent out to the
-- client.
......
{-| Implementation of the Ganeti confd utilities.
This holds a few utility functions that could be useful in both
clients and servers.
-}
{-
Copyright (C) 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Ganeti.Confd.Utils
( getClusterHmac
, parseRequest
, parseMessage
, signMessage
) where
import qualified Data.ByteString as B
import qualified Text.JSON as J
import Ganeti.BasicTypes
import Ganeti.Confd
import Ganeti.Hash
import qualified Ganeti.Constants as C
import Ganeti.HTools.JSON
import Ganeti.HTools.Utils
-- | Returns the HMAC key.
getClusterHmac :: IO HashKey
getClusterHmac = fmap B.unpack $ B.readFile C.confdHmacKey
-- | Parses a signed request.
parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest)
parseRequest key str = do
(SignedMessage hmac msg salt) <- fromJResult "parsing request" $ J.decode str
req <- if verifyMac key (Just salt) msg hmac
then fromJResult "parsing message" $ J.decode msg
else Bad "HMAC verification failed"
return (salt, msg, req)
-- | Mesage parsing. This can either result in a good, valid message,
-- or fail in the Result monad.
parseMessage :: HashKey -> String -> Integer
-> Result (String, ConfdRequest)
parseMessage hmac msg curtime = do
(salt, origmsg, request) <- parseRequest hmac msg
ts <- tryRead "Parsing timestamp" salt::Result Integer
if (abs (ts - curtime) > (fromIntegral C.confdMaxClockSkew))
then fail "Too old/too new timestamp or clock skew"
else return (origmsg, request)
-- | Signs a message with a given key and salt.
signMessage :: HashKey -> String -> String -> SignedMessage
signMessage key salt msg =
SignedMessage { signedMsgMsg = msg
, signedMsgSalt = salt
, signedMsgHmac = hmac
}
where hmac = computeMac key (Just salt) msg
......@@ -33,13 +33,13 @@ import Text.JSON.Types
import qualified Text.JSON
import qualified Ganeti.Luxi as L
import qualified Ganeti.Qlang as Qlang
import Ganeti.HTools.Loader
import Ganeti.HTools.Types
import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
import Ganeti.HTools.JSON
import Ganeti.Qlang as Qlang
{-# ANN module "HLint: ignore Eta reduce" #-}
......@@ -78,7 +78,7 @@ extractArray v =
fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => (JSValue, JSValue) -> m a
fromJValWithStatus (st, v) = do
st' <- fromJVal st
L.checkRS st' v >>= fromJVal
Qlang.checkRS st' v >>= fromJVal
-- | Annotate errors when converting values with owner/attribute for
-- better debugging.
......
......@@ -75,6 +75,8 @@ import System.IO.Error (isEOFErrorType, ioeGetErrorType, isDoesNotExistError)
import System.Process (readProcessWithExitCode)
import qualified Ganeti.Confd as Confd
import qualified Ganeti.Confd.Server as Confd.Server
import qualified Ganeti.Confd.Utils as Confd.Utils
import qualified Ganeti.Config as Config
import qualified Ganeti.Daemon as Daemon
import qualified Ganeti.Hash as Hash
......
......@@ -27,14 +27,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Luxi
( LuxiOp(..)
, ResultStatus(..)
, LuxiReq(..)
, Client
, JobId
, RecvResult(..)
, TagObject(..)
, strOfOp
, checkRS
, getClient
, getServer
, acceptClient
......@@ -183,27 +181,9 @@ $(makeJSONInstance ''LuxiReq)
-- | The serialisation of LuxiOps into strings in messages.
$(genStrOfOp ''LuxiOp "strOfOp")
$(declareIADT "ResultStatus"
[ ("RSNormal", 'rsNormal)
, ("RSUnknown", 'rsUnknown)
, ("RSNoData", 'rsNodata)
, ("RSUnavailable", 'rsUnavail)
, ("RSOffline", 'rsOffline)
])
$(makeJSONInstance ''ResultStatus)
-- | Type holding the initial (unparsed) Luxi call.
data LuxiCall = LuxiCall LuxiReq JSValue
-- | Check that ResultStatus is success or fail with descriptive message.
checkRS :: (Monad m) => ResultStatus -> a -> m a
checkRS RSNormal val = return val
checkRS RSUnknown _ = fail "Unknown field"
checkRS RSNoData _ = fail "No data for a field"
checkRS RSUnavailable _ = fail "Ganeti reports unavailable data"
checkRS RSOffline _ = fail "Ganeti reports resource as offline"
-- | The end-of-message separator.
eOM :: Word8
eOM = 3
......
......@@ -35,6 +35,7 @@ module Ganeti.Qlang
, FieldDefinition(..)
, ResultEntry(..)
, ItemType(..)
, checkRS
) where
import Control.Applicative
......@@ -58,6 +59,15 @@ $(declareIADT "ResultStatus"
])
$(makeJSONInstance ''ResultStatus)
-- | Check that ResultStatus is success or fail with descriptive
-- message.
checkRS :: (Monad m) => ResultStatus -> a -> m a
checkRS RSNormal val = return val
checkRS RSUnknown _ = fail "Unknown field"
checkRS RSNoData _ = fail "No data for a field"
checkRS RSUnavail _ = fail "Ganeti reports unavailable data"
checkRS RSOffline _ = fail "Ganeti reports resource as offline"
-- | Type of a query field.
$(declareSADT "FieldType"
[ ("QFTUnknown", 'C.qftUnknown )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment