Core.hs 9.02 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
{-# LANGUAGE TemplateHaskell #-}

{-| The Ganeti WConfd core functions.

As TemplateHaskell require that splices be defined in a separate
module, we combine all the TemplateHaskell functionality that HTools
needs in this module (except the one for unittests).

-}

{-

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.Core where

34
import Control.Monad (liftM, unless, when)
35
import Control.Monad.State (modify)
Klaus Aehlig's avatar
Klaus Aehlig committed
36
import qualified Data.Map as M
37
import qualified Data.Set as S
38
import Language.Haskell.TH (Name)
39
import qualified System.Random as Rand
40

41
42
import Ganeti.BasicTypes
import qualified Ganeti.JSON as J
Klaus Aehlig's avatar
Klaus Aehlig committed
43
import qualified Ganeti.Locking.Allocation as L
44
45
import Ganeti.Locking.Locks ( GanetiLocks(ConfigLock), LockLevel(LevelConfig)
                            , lockLevel, LockLevel, ClientId )
46
import qualified Ganeti.Locking.Waiting as LW
47
import Ganeti.Objects (ConfigData, DRBDSecret)
48
import Ganeti.WConfd.Language
49
import Ganeti.WConfd.Monad
50
import qualified Ganeti.WConfd.TempRes as T
51
import qualified Ganeti.WConfd.ConfigWriter as CW
52

53
-- * Functions available to the RPC module
54
55
56
57
58

-- Just a test function
echo :: String -> WConfdMonad String
echo = return

59
60
-- ** Configuration related functions

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
checkConfigLock :: ClientId -> L.OwnerState -> WConfdMonad ()
checkConfigLock cid state = do
  la <- readLockAllocation
  unless (L.holdsLock cid ConfigLock state la)
         . failError $ "Requested lock " ++ show state
                       ++ " on the configuration missing"

-- | Read the configuration, checking that a shared lock is held.
-- If not, the call fails.
readConfig :: ClientId -> WConfdMonad ConfigData
readConfig ident = checkConfigLock ident L.OwnShared >> CW.readConfig

-- | Write the configuration, checking that an exclusive lock is held.
-- If not, the call fails.
writeConfig :: ClientId -> ConfigData -> WConfdMonad ()
writeConfig ident cdata =
  checkConfigLock ident L.OwnExclusive >> CW.writeConfig cdata

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
-- *** Locks on the configuration (only transitional, will be removed later)

-- | Tries to acquire 'ConfigLock' for the client.
-- If the second parameter is set to 'True', the lock is acquired in
-- shared mode.
--
-- If the lock was successfully acquired, returns the current configuration
-- state.
lockConfig
    :: ClientId
    -> Bool -- ^ set to 'True' if the lock should be shared
    -> WConfdMonad (J.MaybeForJSON ConfigData)
lockConfig cid shared = do
  let reqtype = if shared then ReqShared else ReqExclusive
  -- warn if we already have the lock, this shouldn't happen
  la <- readLockAllocation
  when (L.holdsLock cid ConfigLock L.OwnShared la)
       . failError $ "Client " ++ show cid ++
                     " already holds a config lock"
  waiting <- tryUpdateLocks cid [(ConfigLock, reqtype)]
  liftM J.MaybeForJSON $ case waiting of
100
    []  -> liftM Just CW.readConfig
101
102
103
104
105
106
107
    _   -> return Nothing

-- | Release the config lock, if the client currently holds it.
unlockConfig
  :: ClientId -> WConfdMonad ()
unlockConfig cid = freeLocksLevel cid LevelConfig

108
109
110
111
112
-- | Force the distribution of configuration without actually modifying it.
-- It is not necessary to hold a lock for this operation.
flushConfig :: WConfdMonad ()
flushConfig = forceConfigStateDistribution

113
114
-- ** Temporary reservations related functions

115
116
117
118
119
120
dropAllReservations :: ClientId -> WConfdMonad ()
dropAllReservations cid =
  modifyTempResState (const . modify $ T.dropAllReservations cid)

-- *** DRBD

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
computeDRBDMap :: WConfdMonad T.DRBDMap
computeDRBDMap = uncurry T.computeDRBDMap =<< readTempResState

-- Allocate a drbd minor.
--
-- The free minor will be automatically computed from the existing devices.
-- A node can be given multiple times in order to allocate multiple minors.
-- The result is the list of minors, in the same order as the passed nodes.
allocateDRBDMinor
  :: T.InstanceUUID -> [T.NodeUUID] -> WConfdMonad [T.DRBDMinor]
allocateDRBDMinor inst nodes =
  modifyTempResStateErr (\cfg -> T.allocateDRBDMinor cfg inst nodes)

-- Release temporary drbd minors allocated for a given instance using
-- 'allocateDRBDMinor'.
--
-- This should be called on the error paths, on the success paths
-- it's automatically called by the ConfigWriter add and update
-- functions.
releaseDRBDMinors
  :: T.InstanceUUID -> WConfdMonad ()
releaseDRBDMinors inst = modifyTempResState (const $ T.releaseDRBDMinors inst)

144
145
-- *** MACs

146
-- Randomly generate a MAC for an instance and reserve it for
147
148
149
150
151
152
153
154
155
156
157
-- a given client.
generateMAC
  :: ClientId -> J.MaybeForJSON T.NetworkUUID -> WConfdMonad T.MAC
generateMAC cid (J.MaybeForJSON netId) = do
  g <- liftIO Rand.newStdGen
  modifyTempResStateErr $ T.generateMAC g cid netId

-- Reserves a MAC for an instance in the list of temporary reservations.
reserveMAC :: ClientId -> T.MAC -> WConfdMonad ()
reserveMAC = (modifyTempResStateErr .) . T.reserveMAC

158
159
160
161
162
163
164
165
166
-- *** DRBDSecrets

-- Randomly generate a DRBDSecret for an instance and reserves it for
-- a given client.
generateDRBDSecret :: ClientId -> WConfdMonad DRBDSecret
generateDRBDSecret cid = do
  g <- liftIO Rand.newStdGen
  modifyTempResStateErr $ T.generateDRBDSecret g cid

167
168
-- ** Locking related functions

Klaus Aehlig's avatar
Klaus Aehlig committed
169
-- | List the locks of a given owner (i.e., a job-id lockfile pair).
170
171
listLocks :: ClientId -> WConfdMonad [(GanetiLocks, L.OwnerState)]
listLocks cid = liftM (M.toList . L.listLocks cid) readLockAllocation
Klaus Aehlig's avatar
Klaus Aehlig committed
172

Klaus Aehlig's avatar
Klaus Aehlig committed
173
174
175
176
-- | List all active locks.
listAllLocks :: WConfdMonad [GanetiLocks]
listAllLocks = liftM L.listAllLocks readLockAllocation

177
178
179
180
-- | List all active locks with their owners.
listAllLocksOwners :: WConfdMonad [(GanetiLocks, [(ClientId, L.OwnerState)])]
listAllLocksOwners = liftM L.listAllLocksOwners readLockAllocation

181
182
183
184
185
-- | Try to update the locks of a given owner (i.e., a job-id lockfile pair).
-- This function always returns immediately. If the lock update was possible,
-- the empty list is returned; otherwise, the lock status is left completly
-- unchanged, and the return value is the list of jobs which need to release
-- some locks before this request can succeed.
186
187
188
tryUpdateLocks :: ClientId -> GanetiLockRequest -> WConfdMonad [ClientId]
tryUpdateLocks cid req =
  liftM S.toList
189
  . (>>= toErrorStr)
190
  $ modifyLockWaiting (LW.updateLocks cid (fromGanetiLockRequest req))
191

Klaus Aehlig's avatar
Klaus Aehlig committed
192
-- | Free all locks of a given owner (i.e., a job-id lockfile pair).
193
194
freeLocks :: ClientId -> WConfdMonad ()
freeLocks cid =
195
  modifyLockWaiting_ $ LW.releaseResources cid
Klaus Aehlig's avatar
Klaus Aehlig committed
196

197
198
-- | Free all locks of a given owner (i.e., a job-id lockfile pair)
-- of a given level in the Ganeti sense (e.g., "cluster", "node").
199
200
freeLocksLevel :: ClientId -> LockLevel -> WConfdMonad ()
freeLocksLevel cid level =
201
  modifyLockWaiting_ $ LW.freeLocksPredicate ((==) level . lockLevel) cid
202

203
-- | Downgrade all locks of the given level to shared.
204
205
downGradeLocksLevel :: ClientId -> LockLevel -> WConfdMonad ()
downGradeLocksLevel cid level =
206
  modifyLockWaiting_ $ LW.downGradeLocksPredicate ((==) level . lockLevel) cid
207

208
-- | Intersect the possesed locks of an owner with a given set.
209
intersectLocks :: ClientId -> [GanetiLocks] -> WConfdMonad ()
210
intersectLocks cid locks = modifyLockWaiting_ $ LW.intersectLocks locks cid
211

212
-- | Opportunistically allocate locks for a given owner.
213
opportunisticLockUnion :: ClientId
214
215
                       -> [(GanetiLocks, L.OwnerState)]
                       -> WConfdMonad [GanetiLocks]
216
opportunisticLockUnion cid req =
217
  modifyLockWaiting $ LW.opportunisticLockUnion cid req
218

219
220
-- * The list of all functions exported to RPC.

221
exportedFunctions :: [Name]
222
exportedFunctions = [ 'echo
223
                    -- config
224
225
                    , 'readConfig
                    , 'writeConfig
226
227
                    , 'lockConfig
                    , 'unlockConfig
228
                    , 'flushConfig
229
230
231
                    -- temporary reservations (common)
                    , 'dropAllReservations
                    -- DRBD
232
233
234
                    , 'computeDRBDMap
                    , 'allocateDRBDMinor
                    , 'releaseDRBDMinors
235
236
237
                    -- MACs
                    , 'reserveMAC
                    , 'generateMAC
238
239
                    -- DRBD secrets
                    , 'generateDRBDSecret
240
                    -- locking
241
                    , 'listLocks
Klaus Aehlig's avatar
Klaus Aehlig committed
242
                    , 'listAllLocks
243
                    , 'listAllLocksOwners
244
                    , 'tryUpdateLocks
Klaus Aehlig's avatar
Klaus Aehlig committed
245
                    , 'freeLocks
246
                    , 'freeLocksLevel
247
                    , 'downGradeLocksLevel
248
                    , 'intersectLocks
249
                    , 'opportunisticLockUnion
250
                    ]