code.grnet.gr Git - ganeti-local/blob - htools/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   , keyToFilename
  34   , sSFilePrefix
  35   ) where
  36
  37 import Ganeti.THH
  38
  39 import Control.Exception
  40 import Control.Monad (liftM)
  41 import Data.Char (isSpace)
  42 import Data.Maybe (fromMaybe)
  43 import Prelude hiding (catch)
  44 import qualified Network.Socket as Socket
  45 import System.FilePath ((</>))
  46 import System.IO.Error (isDoesNotExistError)
  47
  48 import qualified Ganeti.Constants as C
  49 import Ganeti.BasicTypes
  50 import Ganeti.HTools.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 :: Maybe FilePath     -- ^ Optional config path override
  87               -> SSKey              -- ^ ssconf key
  88               -> FilePath
  89 keyToFilename optpath key = fromMaybe C.dataDir optpath </>
  90                             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   catch (do
 100           result <- action
 101           return (Ok result)
 102         ) (\err -> let bad_result = Bad (show err)
 103                    in return $ if isDoesNotExistError err
 104                                  then maybe bad_result Ok def
 105                                  else bad_result)
 106
 107 -- | Read an ssconf file.
 108 readSSConfFile :: Maybe FilePath            -- ^ Optional config path override
 109                -> Maybe String              -- ^ Optional default value
 110                -> SSKey                     -- ^ Desired ssconf key
 111                -> IO (Result String)
 112 readSSConfFile optpath def key = do
 113   result <- catchIOErrors def . readFile . keyToFilename optpath $ key
 114   return (liftM (take maxFileSize) result)
 115
 116 -- | Strip space characthers (including newline). As this is
 117 -- expensive, should only be run on small strings.
 118 rstripSpace :: String -> String
 119 rstripSpace = reverse . dropWhile isSpace . reverse
 120
 121 -- | Parses a string containing an IP family
 122 parseIPFamily :: Int -> Result Socket.Family
 123 parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
 124                   | fam == C.ip6Family = Ok Socket.AF_INET6
 125                   | otherwise = Bad $ "Unknown af_family value: " ++ show fam
 126
 127 -- | Read the primary IP family.
 128 getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
 129 getPrimaryIPFamily optpath = do
 130   result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
 131   return (liftM rstripSpace result >>=
 132           tryRead "Parsing af_family" >>= parseIPFamily)