ConfigWriter.hs 7.48 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
{-# 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
35
36
  , saveConfigAsyncTask
  , distMCsAsyncTask
37
  , distSSConfAsyncTask
38
39
40
41
42
43
  ) where

import Control.Applicative
import Control.Monad.Base
import Control.Monad.Error
import qualified Control.Monad.State.Strict as S
44
import Control.Monad.Trans.Control
45
46
47
48

import Ganeti.BasicTypes
import Ganeti.Errors
import Ganeti.Config
49
import Ganeti.Logging
50
import Ganeti.Objects
51
import Ganeti.Rpc
52
53
54
55
56
57
import Ganeti.Runtime
import Ganeti.Utils
import Ganeti.Utils.Atomic
import Ganeti.Utils.AsyncWorker
import Ganeti.WConfd.ConfigState
import Ganeti.WConfd.Monad
58
import Ganeti.WConfd.Ssconf
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

-- | 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
76
77
    logDebug $ "Async. config. writer: Commencing write\
               \ serial no " ++ show (serialOf cfg)
78
79
80
81
82
83
84
85
86
87
    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

88
89
90
91
92
93
94
95
96
97
-- 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

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
-- | 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

117
118
-- | Creates an asynchronous task that handles errors in its actions.
-- If an error occurs, it's logged and the internal state remains unchanged.
119
mkStatefulAsyncTask :: (MonadBaseControl IO m, MonadLog m, Show e)
120
121
122
                    => Priority
                    -> String
                    -> s
123
                    -> (s -> ResultT e m s)
124
                    -> m (AsyncWorker ())
125
mkStatefulAsyncTask logPrio logPrefix start action =
126
127
    flip S.evalStateT start . mkAsyncWorker $
      S.get >>= lift . runResultT . action
128
            >>= finishOrLog logPrio logPrefix S.put -- put on success
129

130
131
132
133
134
135
136
137
138
139
-- | 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 =
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
  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
165
166
          logDebug $ "Distributing the configuration to master candidates,\
                     \ serial no " ++ show (serialOf cd)
167
168
          fupload <- prepareRpcCallUploadFile ents cpath
          execRpcCallAndLog (getMasterCandidates cd) fupload
169
          logDebug "Successfully finished distributing the configuration"
170
171
172
173
174
175
176
177
178
179
180
181
182
183

-- | Construct an asynchronous worker whose action is to construct SSConf
-- and distribute it to master candidates.
-- The worker's action reads the configuration using the given @IO@ action,
-- computes the current SSConf, compares it to the previous version, and
-- if different, distributes it.
distSSConfAsyncTask
    :: IO ConfigState -- ^ An action to read the current config
    -> ResultG (AsyncWorker ())
distSSConfAsyncTask cdRef =
  lift . mkStatefulAsyncTask ERROR "Can't distribute Ssconf" emptySSConf
       $ \oldssc -> do
            cd <- liftBase (csConfigData <$> cdRef) :: ResultG ConfigData
            let ssc = mkSSConf cd
184
185
186
187
188
189
            if oldssc == ssc
              then logDebug "SSConf unchanged, not distributing"
              else do
                logDebug $ "Starting the distribution of SSConf\
                           \ serial no " ++ show (serialOf cd)
                execRpcCallAndLog (getOnlineNodes cd)
190
                                  (RpcCallWriteSsconfFiles ssc)
191
                logDebug "Successfully finished distributing SSConf"
192
            return ssc