diff --git a/Makefile.am b/Makefile.am index 8dc4380e2e132077bc313324747fa48991baa10e..54f027030d1fbd55a75917f606af5b32335b5fad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs index 9b41e69c45a6741f4673fe591eed213692175770..6c0a0242f268cafa91c2ca1af0229d8dcf541b24 100644 --- a/htools/Ganeti/Confd/Server.hs +++ b/htools/Ganeti/Confd/Server.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. diff --git a/htools/Ganeti/Confd/Utils.hs b/htools/Ganeti/Confd/Utils.hs new file mode 100644 index 0000000000000000000000000000000000000000..707957deebb0e17073d4c0a63eafe7fa43417f95 --- /dev/null +++ b/htools/Ganeti/Confd/Utils.hs @@ -0,0 +1,77 @@ +{-| 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 diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs index fb1699dd0cd69f322f2459e4c2d4d18d7e468ad2..18f587d1d87d56e69dfe7aa0c7a7f194f1bba728 100644 --- a/htools/Ganeti/HTools/Luxi.hs +++ b/htools/Ganeti/HTools/Luxi.hs @@ -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. diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs index 37fded7d85b07145d0d186e232f34dfbe858c7cf..15e591c8e8e1803db0a39729e0964a441bbc30ba 100644 --- a/htools/Ganeti/HTools/QC.hs +++ b/htools/Ganeti/HTools/QC.hs @@ -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 diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs index 0ac40e792c2cace9e832080d2f68de286b261230..77a29b998e05472aa560f34acbf33ba7f6f68a90 100644 --- a/htools/Ganeti/Luxi.hs +++ b/htools/Ganeti/Luxi.hs @@ -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 diff --git a/htools/Ganeti/Qlang.hs b/htools/Ganeti/Qlang.hs index 78bb9fa0c04dbd1052efb0e9754abe274045e05c..b88a05e63e97ad82a17b0e1c0cd72618a9642801 100644 --- a/htools/Ganeti/Qlang.hs +++ b/htools/Ganeti/Qlang.hs @@ -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 )