Synnefo » snf-ganeti

{-# LANGUAGE RankNTypes, FlexibleContexts #-}

{-| Implementation of functions specific to configuration management.

TODO: Detect changes in SSConf and distribute only if it changes

TODO: distribute ssconf configuration, if it has changed

-}

{-

Copyright (C) 2013 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.WConfd.ConfigWriter

  ( loadConfigFromFile

  , readConfig

  , writeConfig

  , saveConfigAsyncTask

  , distMCsAsyncTask

  ) where

import Control.Applicative

import Control.Monad.Base

import Control.Monad.Error

import qualified Control.Monad.State.Strict as S

import Control.Monad.Trans.Control

import Ganeti.BasicTypes

import Ganeti.Errors

import Ganeti.Config

import Ganeti.Logging

import Ganeti.Objects

import Ganeti.Rpc

import Ganeti.Runtime

import Ganeti.Utils

import Ganeti.Utils.Atomic

import Ganeti.Utils.AsyncWorker

import Ganeti.WConfd.ConfigState

import Ganeti.WConfd.Monad

-- | Loads the configuration from the file, if it hasn't been loaded yet.

-- The function is internal and isn't thread safe.

loadConfigFromFile :: FilePath

                   -> ResultG (ConfigData, FStat)

loadConfigFromFile path = withLockedFile path $ \_ -> do

    stat <- liftBase $ getFStat path

    cd <- mkResultT (loadConfig path)

    return (cd, stat)

-- | Writes the current configuration to the file. The function isn't thread

-- safe.

-- Neither distributes the configuration (to nodes and ssconf) nor

-- updates the serial number.

writeConfigToFile :: (MonadBase IO m, MonadError GanetiException m, MonadLog m)

                  => ConfigData -> FilePath -> FStat -> m FStat

writeConfigToFile cfg path oldstat = do

    logDebug "Async. config. writer: Commencing write"

    r <- toErrorBase $ atomicUpdateLockedFile_ path oldstat doWrite

    logDebug "Async. config. writer: written"

    return r

  where

    doWrite fname fh = do

      setOwnerAndGroupFromNames fname GanetiWConfd

                                (DaemonGroup GanetiConfd)

      setOwnerWGroupR fname

      saveConfig fh cfg

-- Reads the current configuration state in the 'WConfdMonad'.

readConfig :: WConfdMonad ConfigData

readConfig = csConfigData <$> readConfigState

-- Replaces the current configuration state within the 'WConfdMonad'.

writeConfig :: ConfigData -> WConfdMonad ()

writeConfig cd = modifyConfigState $ const (mkConfigState cd, ())

-- * Asynchronous tasks

-- | Runs the given action on success, or logs an error on failure.

finishOrLog :: (Show e, MonadLog m)

            => Priority

            -> String

            -> (a -> m ())

            -> GenericResult e a

            -> m ()

finishOrLog logPrio logPrefix =

  genericResult (logAt logPrio . (++) (logPrefix ++ ": ") . show)

-- | Creates a stateless asynchronous task that handles errors in its actions.

mkStatelessAsyncTask :: (MonadBaseControl IO m, MonadLog m, Show e)

                     => Priority

                     -> String

                     -> ResultT e m ()

                     -> m (AsyncWorker ())

mkStatelessAsyncTask logPrio logPrefix action =

    mkAsyncWorker $ runResultT action >>= finishOrLog logPrio logPrefix return

-- | Creates an asynchronous task that handles errors in its actions.

-- If an error occurs, it's logged and the internal state remains unchanged.

mkStatefulAsyncTask :: (MonadBaseControl IO m, MonadLog m, Show e)

                    => Priority

                    -> String

                    -> s

                    -> (s -> ResultT e m s)

                    -> m (AsyncWorker ())

mkStatefulAsyncTask logPrio logPrefix start action =

    flip S.evalStateT start . mkAsyncWorker $

      S.get >>= lift . runResultT . action

            >>= finishOrLog logPrio logPrefix S.put -- put on success

-- | Construct an asynchronous worker whose action is to save the

-- configuration to the master file.

-- The worker's action reads the configuration using the given @IO@ action

-- and uses 'FStat' to check if the configuration hasn't been modified by

-- another process.

saveConfigAsyncTask :: FilePath -- ^ Path to the config file

                    -> FStat  -- ^ The initial state of the config. file

                    -> IO ConfigState -- ^ An action to read the current config

                    -> ResultG (AsyncWorker ())

saveConfigAsyncTask fpath fstat cdRef =

  lift . mkStatefulAsyncTask

           EMERGENCY "Can't write the master configuration file" fstat

       $ \oldstat -> do

            cd <- liftBase (csConfigData `liftM` cdRef)

            writeConfigToFile cd fpath oldstat

-- | Performs a RPC call on the given list of nodes and logs any failures.

-- If any of the calls fails, fail the computation with 'failError'.

execRpcCallAndLog :: (Rpc a b) => [Node] -> a -> ResultG ()

execRpcCallAndLog nodes req = do

  rs <- liftIO $ executeRpcCall nodes req

  es <- logRpcErrors rs

  unless (null es) $ failError "At least one of the RPC calls failed"

-- | Construct an asynchronous worker whose action is to distribute the

-- configuration to master candidates.

distMCsAsyncTask :: RuntimeEnts

                 -> FilePath -- ^ Path to the config file

                 -> IO ConfigState -- ^ An action to read the current config

                 -> ResultG (AsyncWorker ())

distMCsAsyncTask ents cpath cdRef =

  lift . mkStatelessAsyncTask ERROR "Can't distribute the configuration\

                                    \ to master candidates"

       $ do

          cd <- liftBase (csConfigData <$> cdRef) :: ResultG ConfigData

          fupload <- prepareRpcCallUploadFile ents cpath

          execRpcCallAndLog (getMasterCandidates cd) fupload