Core.hs 15.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
{-# 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.
Klaus Aehlig's avatar
Klaus Aehlig committed
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
38 39 40 41 42

-}

module Ganeti.WConfd.Core where

43
import Control.Arrow ((&&&))
44 45
import Control.Concurrent (myThreadId)
import Control.Lens.Setter (set)
46
import Control.Monad (liftM, unless, when)
Klaus Aehlig's avatar
Klaus Aehlig committed
47
import qualified Data.Map as M
48
import qualified Data.Set as S
49
import Language.Haskell.TH (Name)
50
import System.Posix.Process (getProcessID)
51
import qualified System.Random as Rand
52

53
import Ganeti.BasicTypes
54
import qualified Ganeti.Constants as C
55
import qualified Ganeti.JSON as J
Klaus Aehlig's avatar
Klaus Aehlig committed
56
import qualified Ganeti.Locking.Allocation as L
57 58 59 60 61
import Ganeti.Logging (logDebug)
import Ganeti.Locking.Locks ( GanetiLocks(ConfigLock, BGL)
                            , LockLevel(LevelConfig)
                            , lockLevel, LockLevel
                            , ClientType(ClientOther), ClientId(..) )
62
import qualified Ganeti.Locking.Waiting as LW
63
import Ganeti.Objects (ConfigData, DRBDSecret, LogicalVolume, Ip4Address)
64 65
import Ganeti.Objects.Lens (configClusterL, clusterMasterNodeL)
import Ganeti.WConfd.ConfigState (csConfigDataL)
66
import qualified Ganeti.WConfd.ConfigVerify as V
67
import Ganeti.WConfd.Language
68
import Ganeti.WConfd.Monad
69
import qualified Ganeti.WConfd.TempRes as T
70
import qualified Ganeti.WConfd.ConfigWriter as CW
71

72
-- * Functions available to the RPC module
73 74 75 76 77

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

78 79
-- ** Configuration related functions

80 81 82 83 84 85 86
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"

87 88 89
-- | Read the configuration.
readConfig :: WConfdMonad ConfigData
readConfig = CW.readConfig
90 91 92 93

-- | Write the configuration, checking that an exclusive lock is held.
-- If not, the call fails.
writeConfig :: ClientId -> ConfigData -> WConfdMonad ()
94 95 96 97 98 99 100 101 102
writeConfig ident cdata = do
  checkConfigLock ident L.OwnExclusive
  -- V.verifyConfigErr cdata
  CW.writeConfig cdata

-- | Explicitly run verification of the configuration.
-- The caller doesn't need to hold the configuration lock.
verifyConfig :: WConfdMonad ()
verifyConfig = CW.readConfig >>= V.verifyConfigErr
103

104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
-- *** 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
125
    []  -> liftM Just CW.readConfig
126 127 128 129 130 131 132
    _   -> return Nothing

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

133 134 135 136 137
-- | Force the distribution of configuration without actually modifying it.
-- It is not necessary to hold a lock for this operation.
flushConfig :: WConfdMonad ()
flushConfig = forceConfigStateDistribution

138 139
-- ** Temporary reservations related functions

140 141
dropAllReservations :: ClientId -> WConfdMonad ()
dropAllReservations cid =
142
  modifyTempResState (const $ T.dropAllReservations cid)
143 144 145

-- *** DRBD

146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
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)

169 170
-- *** MACs

171
-- Randomly generate a MAC for an instance and reserve it for
172 173 174 175 176 177 178 179 180 181 182
-- 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

183 184 185 186 187 188 189 190 191
-- *** 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

192 193 194 195 196
-- *** LVs

reserveLV :: ClientId -> LogicalVolume -> WConfdMonad ()
reserveLV jobId lv = modifyTempResStateErr $ T.reserveLV jobId lv

197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
-- *** IPv4s

-- | Reserve a given IPv4 address for use by an instance.
reserveIp :: ClientId -> T.NetworkUUID -> Ip4Address -> Bool -> WConfdMonad ()
reserveIp = (((modifyTempResStateErr .) .) .) . T.reserveIp

-- | Give a specific IP address back to an IP pool.
-- The IP address is returned to the IP pool designated by network id
-- and marked as reserved.
releaseIp :: ClientId -> T.NetworkUUID -> Ip4Address -> WConfdMonad ()
releaseIp = (((modifyTempResStateErr .) const .) .) . T.releaseIp

-- Find a free IPv4 address for an instance and reserve it.
generateIp :: ClientId -> T.NetworkUUID -> WConfdMonad Ip4Address
generateIp = (modifyTempResStateErr .) . T.generateIp

-- | Commit all reserved/released IP address to an IP pool.
-- The IP addresses are taken from the network's IP pool and marked as
-- reserved/free for instances.
--
-- Note that the reservations are kept, they are supposed to be cleaned
-- when a job finishes.
commitTemporaryIps :: ClientId -> WConfdMonad ()
commitTemporaryIps = modifyConfigDataErr_ . T.commitReservedIps

-- | Immediately release an IP address, without using the reservations pool.
commitReleaseTemporaryIp
  :: T.NetworkUUID -> Ip4Address -> WConfdMonad ()
commitReleaseTemporaryIp net_uuid addr =
  modifyConfigDataErr_ (const $ T.commitReleaseIp net_uuid addr)

-- | List all IP reservations for the current client.
--
-- This function won't be needed once the corresponding calls are moved to
-- WConfd.
listReservedIps :: ClientId -> WConfdMonad [T.IPv4Reservation]
listReservedIps jobId =
  liftM (S.toList . T.listReservedIps jobId . snd) readTempResState

236 237
-- ** Locking related functions

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

Klaus Aehlig's avatar
Klaus Aehlig committed
242 243 244 245
-- | List all active locks.
listAllLocks :: WConfdMonad [GanetiLocks]
listAllLocks = liftM L.listAllLocks readLockAllocation

246 247 248 249
-- | List all active locks with their owners.
listAllLocksOwners :: WConfdMonad [(GanetiLocks, [(ClientId, L.OwnerState)])]
listAllLocksOwners = liftM L.listAllLocksOwners readLockAllocation

250 251 252 253 254 255 256 257 258 259
-- | Get full information of the lock waiting status, i.e., provide
-- the information about all locks owners and all pending requests.
listLocksWaitingStatus :: WConfdMonad
                            ( [(GanetiLocks, [(ClientId, L.OwnerState)])]
                            , [(Integer, ClientId, [L.LockRequest GanetiLocks])]
                            )
listLocksWaitingStatus = liftM ( (L.listAllLocksOwners . LW.getAllocation)
                                 &&& (S.toList . LW.getPendingRequests) )
                         readLockWaiting

260 261 262 263 264
-- | 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.
265 266 267
tryUpdateLocks :: ClientId -> GanetiLockRequest -> WConfdMonad [ClientId]
tryUpdateLocks cid req =
  liftM S.toList
268
  . (>>= toErrorStr)
269
  $ modifyLockWaiting (LW.updateLocks cid (fromGanetiLockRequest req))
270

271 272 273 274 275 276 277 278
-- | Try to update the locks of a given owner and make that a pending
-- request if not immediately possible.
updateLocksWaiting :: ClientId -> Integer
                      -> GanetiLockRequest -> WConfdMonad [ClientId]
updateLocksWaiting cid prio req =
  liftM S.toList
  . (>>= toErrorStr)
  . modifyLockWaiting
279
  $ LW.safeUpdateLocksWaiting prio cid (fromGanetiLockRequest req)
280

281 282 283 284
-- | Tell whether a given owner has pending requests.
hasPendingRequest :: ClientId -> WConfdMonad Bool
hasPendingRequest cid = liftM (LW.hasPendingRequest cid) readLockWaiting

Klaus Aehlig's avatar
Klaus Aehlig committed
285
-- | Free all locks of a given owner (i.e., a job-id lockfile pair).
286 287
freeLocks :: ClientId -> WConfdMonad ()
freeLocks cid =
288
  modifyLockWaiting_ $ LW.releaseResources cid
Klaus Aehlig's avatar
Klaus Aehlig committed
289

290 291
-- | 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").
292 293
freeLocksLevel :: ClientId -> LockLevel -> WConfdMonad ()
freeLocksLevel cid level =
294
  modifyLockWaiting_ $ LW.freeLocksPredicate ((==) level . lockLevel) cid
295

296
-- | Downgrade all locks of the given level to shared.
297 298
downGradeLocksLevel :: ClientId -> LockLevel -> WConfdMonad ()
downGradeLocksLevel cid level =
299
  modifyLockWaiting_ $ LW.downGradeLocksPredicate ((==) level . lockLevel) cid
300

301
-- | Intersect the possesed locks of an owner with a given set.
302
intersectLocks :: ClientId -> [GanetiLocks] -> WConfdMonad ()
303
intersectLocks cid locks = modifyLockWaiting_ $ LW.intersectLocks locks cid
304

305
-- | Opportunistically allocate locks for a given owner.
306
opportunisticLockUnion :: ClientId
307 308
                       -> [(GanetiLocks, L.OwnerState)]
                       -> WConfdMonad [GanetiLocks]
309
opportunisticLockUnion cid req =
310
  modifyLockWaiting $ LW.opportunisticLockUnion cid req
311

312 313 314 315 316 317 318 319 320
-- | Opprtunistially allocate locks for a given owner, requesting a
-- certain minimum of success.
guardedOpportunisticLockUnion :: Int
                                 -> ClientId
                                 -> [(GanetiLocks, L.OwnerState)]
                                 -> WConfdMonad [GanetiLocks]
guardedOpportunisticLockUnion count cid req =
  modifyLockWaiting $ LW.guardedOpportunisticLockUnion count cid req

321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
-- * Prepareation for cluster destruction

-- | Prepare daemon for cluster destruction. This consists of
-- verifying that the requester owns the BGL exclusively, transfering the BGL
-- to WConfD itself, and modifying the configuration so that no
-- node is the master any more. Note that, since we own the BGL exclusively,
-- we can safely modify the configuration, as no other process can request
-- changes.
prepareClusterDestruction :: ClientId -> WConfdMonad ()
prepareClusterDestruction cid = do
  la <- readLockAllocation
  unless (L.holdsLock cid BGL L.OwnExclusive la)
    . failError $ "Cluster destruction requested without owning BGL exclusively"
  logDebug $ "preparing cluster destruction as requested by " ++ show cid
  -- transfer BGL to ourselfs. The do this, by adding a super-priority waiting
  -- request and then releasing the BGL of the requestor.
  dh <- daemonHandle
  pid <- liftIO getProcessID
  tid <- liftIO myThreadId
  let mycid = ClientId { ciIdentifier = ClientOther $ "wconfd-" ++ show tid
                       , ciLockFile = dhLivelock dh
                       , ciPid = pid
                       }
  _ <- modifyLockWaiting $ LW.updateLocksWaiting
                           (fromIntegral C.opPrioHighest - 1) mycid
                           [L.requestExclusive BGL]
  _ <- modifyLockWaiting $ LW.updateLocks cid [L.requestRelease BGL]
  -- To avoid beeing restarted we change the configuration to a no-master
  -- state.
  modifyConfigState $ (,) ()
    . set (csConfigDataL . configClusterL . clusterMasterNodeL) ""


354 355
-- * The list of all functions exported to RPC.

356
exportedFunctions :: [Name]
357
exportedFunctions = [ 'echo
358
                    , 'prepareClusterDestruction
359
                    -- config
360 361
                    , 'readConfig
                    , 'writeConfig
362
                    , 'verifyConfig
363 364
                    , 'lockConfig
                    , 'unlockConfig
365
                    , 'flushConfig
366 367 368
                    -- temporary reservations (common)
                    , 'dropAllReservations
                    -- DRBD
369 370 371
                    , 'computeDRBDMap
                    , 'allocateDRBDMinor
                    , 'releaseDRBDMinors
372 373 374
                    -- MACs
                    , 'reserveMAC
                    , 'generateMAC
375 376
                    -- DRBD secrets
                    , 'generateDRBDSecret
377 378
                    -- LVs
                    , 'reserveLV
379 380 381 382 383 384 385
                    -- IPv4s
                    , 'reserveIp
                    , 'releaseIp
                    , 'generateIp
                    , 'commitTemporaryIps
                    , 'commitReleaseTemporaryIp
                    , 'listReservedIps
386
                    -- locking
387
                    , 'listLocks
Klaus Aehlig's avatar
Klaus Aehlig committed
388
                    , 'listAllLocks
389
                    , 'listAllLocksOwners
390
                    , 'listLocksWaitingStatus
391
                    , 'tryUpdateLocks
392
                    , 'updateLocksWaiting
Klaus Aehlig's avatar
Klaus Aehlig committed
393
                    , 'freeLocks
394
                    , 'freeLocksLevel
395
                    , 'downGradeLocksLevel
396
                    , 'intersectLocks
397
                    , 'opportunisticLockUnion
398
                    , 'guardedOpportunisticLockUnion
399
                    , 'hasPendingRequest
400
                    ]