code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Ssconf.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of the Ganeti Ssconf interface.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2012 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.Ssconf
  29   ( SSKey(..)
  30   , sSKeyToRaw
  31   , sSKeyFromRaw
  32   , getPrimaryIPFamily
  33   , getMasterCandidatesIps
  34   , keyToFilename
  35   , sSFilePrefix
  36   ) where
  37
  38 import Ganeti.THH
  39
  40 import Control.Exception
  41 import Control.Monad (liftM)
  42 import Data.Maybe (fromMaybe)
  43 import qualified Network.Socket as Socket
  44 import System.FilePath ((</>))
  45 import System.IO.Error (isDoesNotExistError)
  46
  47 import qualified Ganeti.Constants as C
  48 import qualified Ganeti.Path as Path
  49 import Ganeti.BasicTypes
  50 import Ganeti.Utils
  51
  52 -- | Maximum ssconf file size we support.
  53 maxFileSize :: Int
  54 maxFileSize = 131072
  55
  56 -- | ssconf file prefix, re-exported from Constants.
  57 sSFilePrefix :: FilePath
  58 sSFilePrefix = C.ssconfFileprefix
  59
  60 $(declareSADT "SSKey"
  61   [ ("SSClusterName",          'C.ssClusterName)
  62   , ("SSClusterTags",          'C.ssClusterTags)
  63   , ("SSFileStorageDir",       'C.ssFileStorageDir)
  64   , ("SSSharedFileStorageDir", 'C.ssSharedFileStorageDir)
  65   , ("SSMasterCandidates",     'C.ssMasterCandidates)
  66   , ("SSMasterCandidatesIps",  'C.ssMasterCandidatesIps)
  67   , ("SSMasterIp",             'C.ssMasterIp)
  68   , ("SSMasterNetdev",         'C.ssMasterNetdev)
  69   , ("SSMasterNetmask",        'C.ssMasterNetmask)
  70   , ("SSMasterNode",           'C.ssMasterNode)
  71   , ("SSNodeList",             'C.ssNodeList)
  72   , ("SSNodePrimaryIps",       'C.ssNodePrimaryIps)
  73   , ("SSNodeSecondaryIps",     'C.ssNodeSecondaryIps)
  74   , ("SSOfflineNodes",         'C.ssOfflineNodes)
  75   , ("SSOnlineNodes",          'C.ssOnlineNodes)
  76   , ("SSPrimaryIpFamily",      'C.ssPrimaryIpFamily)
  77   , ("SSInstanceList",         'C.ssInstanceList)
  78   , ("SSReleaseVersion",       'C.ssReleaseVersion)
  79   , ("SSHypervisorList",       'C.ssHypervisorList)
  80   , ("SSMaintainNodeHealth",   'C.ssMaintainNodeHealth)
  81   , ("SSUidPool",              'C.ssUidPool)
  82   , ("SSNodegroups",           'C.ssNodegroups)
  83   ])
  84
  85 -- | Convert a ssconf key into a (full) file path.
  86 keyToFilename :: FilePath     -- ^ Config path root
  87               -> SSKey        -- ^ Ssconf key
  88               -> FilePath     -- ^ Full file name
  89 keyToFilename cfgpath key =
  90   cfgpath </> sSFilePrefix ++ sSKeyToRaw key
  91
  92 -- | Runs an IO action while transforming any error into 'Bad'
  93 -- values. It also accepts an optional value to use in case the error
  94 -- is just does not exist.
  95 catchIOErrors :: Maybe a         -- ^ Optional default
  96               -> IO a            -- ^ Action to run
  97               -> IO (Result a)
  98 catchIOErrors def action =
  99   Control.Exception.catch
 100         (do
 101           result <- action
 102           return (Ok result)
 103         ) (\err -> let bad_result = Bad (show err)
 104                    in return $ if isDoesNotExistError err
 105                                  then maybe bad_result Ok def
 106                                  else bad_result)
 107
 108 -- | Read an ssconf file.
 109 readSSConfFile :: Maybe FilePath            -- ^ Optional config path override
 110                -> Maybe String              -- ^ Optional default value
 111                -> SSKey                     -- ^ Desired ssconf key
 112                -> IO (Result String)
 113 readSSConfFile optpath def key = do
 114   dpath <- Path.dataDir
 115   result <- catchIOErrors def . readFile .
 116             keyToFilename (fromMaybe dpath optpath) $ key
 117   return (liftM (take maxFileSize) result)
 118
 119 -- | Parses a string containing an IP family
 120 parseIPFamily :: Int -> Result Socket.Family
 121 parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
 122                   | fam == C.ip6Family = Ok Socket.AF_INET6
 123                   | otherwise = Bad $ "Unknown af_family value: " ++ show fam
 124
 125 -- | Read the primary IP family.
 126 getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
 127 getPrimaryIPFamily optpath = do
 128   result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
 129   return (liftM rStripSpace result >>=
 130           tryRead "Parsing af_family" >>= parseIPFamily)
 131
 132 -- | Read the list of IP addresses of the master candidates of the cluster.
 133 getMasterCandidatesIps :: Maybe FilePath -> IO (Result [String])
 134 getMasterCandidatesIps optPath = do
 135   result <- readSSConfFile optPath Nothing SSMasterCandidatesIps
 136   return $ liftM lines result