Revision 94c7e022

b/src/Ganeti/WConfd/ConfigWriter.hs
2 2 

  		





  3
  3
  
    
{-| Implementation of functions specific to configuration management.


  		





  4
  4
  
    

  		





  5
  
  
    
TODO: distribute the configuration to master candidates (and not the master)


  		





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


  		





  7
  6
  
    
TODO: distribute ssconf configuration, if it has changed


  		





  8
  7
  
    

  		





  ......




  31
  30
  
    

  		





  32
  31
  
    
module Ganeti.WConfd.ConfigWriter


  		





  33
  32
  
    
  ( loadConfigFromFile


  		





  34
  
  
    
  , saveConfigAsyncTask


  		





  35
  33
  
    
  , readConfig


  		





  36
  34
  
    
  , writeConfig


  		





  
  35
  
    
  , saveConfigAsyncTask


  		





  
  36
  
    
  , distMCsAsyncTask


  		





  37
  37
  
    
  ) where


  		





  38
  38
  
    

  		





  39
  39
  
    
import Control.Applicative


  		





  ......




  45
  45
  
    
import Ganeti.BasicTypes


  		





  46
  46
  
    
import Ganeti.Errors


  		





  47
  47
  
    
import Ganeti.Config


  		





  48
  
  
    
import Ganeti.Logging.Lifted


  		





  
  48
  
    
import Ganeti.Logging


  		





  49
  49
  
    
import Ganeti.Objects


  		





  
  50
  
    
import Ganeti.Rpc


  		





  50
  51
  
    
import Ganeti.Runtime


  		





  51
  52
  
    
import Ganeti.Utils


  		





  52
  53
  
    
import Ganeti.Utils.Atomic


  		





  ......




  91
  92
  
    

  		





  92
  93
  
    
-- * Asynchronous tasks


  		





  93
  94
  
    

  		





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


  		





  
  96
  
    
finishOrLog :: (Show e, MonadLog m)


  		





  
  97
  
    
            => Priority


  		





  
  98
  
    
            -> String


  		





  
  99
  
    
            -> (a -> m ())


  		





  
  100
  
    
            -> GenericResult e a


  		





  
  101
  
    
            -> m ()


  		





  
  102
  
    
finishOrLog logPrio logPrefix =


  		





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


  		





  
  104
  
    

  		





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


  		





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


  		





  
  107
  
    
                     => Priority


  		





  
  108
  
    
                     -> String


  		





  
  109
  
    
                     -> ResultT e m ()


  		





  
  110
  
    
                     -> m (AsyncWorker ())


  		





  
  111
  
    
mkStatelessAsyncTask logPrio logPrefix action =


  		





  
  112
  
    
    mkAsyncWorker $ runResultT action >>= finishOrLog logPrio logPrefix return


  		





  
  113
  
    

  		





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


  		





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


  		





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


  		





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


  		





  97
  117
  
    
                    => Priority


  		





  98
  118
  
    
                    -> String


  		





  99
  
  
    
                    -> (s -> ResultT e m s)


  		





  100
  119
  
    
                    -> s


  		





  
  120
  
    
                    -> (s -> ResultT e m s)


  		





  101
  121
  
    
                    -> m (AsyncWorker ())


  		





  102
  
  
    
mkStatefulAsyncTask logPrio logPrefix action start =


  		





  
  122
  
    
mkStatefulAsyncTask logPrio logPrefix start action =


  		





  103
  123
  
    
    flip S.evalStateT start . mkAsyncWorker $


  		





  104
  124
  
    
      S.get >>= lift . runResultT . action


  		





  105
  
  
    
            >>= genericResult


  		





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


  		





  107
  
  
    
                  S.put -- on success save the state


  		





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


  		





  108
  126
  
    

  		





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


  		





  110
  128
  
    
-- configuration to the master file.


  		





  ......




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


  		





  117
  135
  
    
                    -> ResultG (AsyncWorker ())


  		





  118
  136
  
    
saveConfigAsyncTask fpath fstat cdRef =


  		





  119
  
  
    
  let action oldstat = do


  		





  120
  
  
    
                        cd <- liftBase (csConfigData `liftM` cdRef)


  		





  121
  
  
    
                        writeConfigToFile cd fpath oldstat


  		





  122
  
  
    
  in lift $ mkStatefulAsyncTask


  		





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


  		





  124
  
  
    
              action fstat


  		





  
  137
  
    
  lift . mkStatefulAsyncTask


  		





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


  		





  
  139
  
    
       $ \oldstat -> do


  		





  
  140
  
    
            cd <- liftBase (csConfigData `liftM` cdRef)


  		





  
  141
  
    
            writeConfigToFile cd fpath oldstat


  		





  
  142
  
    

  		





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


  		





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


  		





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


  		





  
  146
  
    
execRpcCallAndLog nodes req = do


  		





  
  147
  
    
  rs <- liftIO $ executeRpcCall nodes req


  		





  
  148
  
    
  es <- logRpcErrors rs


  		





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


  		





  
  150
  
    

  		





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


  		





  
  152
  
    
-- configuration to master candidates.


  		





  
  153
  
    
distMCsAsyncTask :: RuntimeEnts


  		





  
  154
  
    
                 -> FilePath -- ^ Path to the config file


  		





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


  		





  
  156
  
    
                 -> ResultG (AsyncWorker ())


  		





  
  157
  
    
distMCsAsyncTask ents cpath cdRef =


  		





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


  		





  
  159
  
    
                                    \ to master candidates"


  		





  
  160
  
    
       $ do


  		





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


  		





  
  162
  
    
          fupload <- prepareRpcCallUploadFile ents cpath


  		





  
  163
  
    
          execRpcCallAndLog (getMasterCandidates cd) fupload


  		












Also available in:
  Unified diff