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 qualified Ganeti.Path as Path
  50 import Ganeti.BasicTypes
  51 import Ganeti.Utils
  52
  53 -- | Maximum ssconf file size we support.
  54 maxFileSize :: Int
  55 maxFileSize = 131072
  56
  57 -- | ssconf file prefix, re-exported from Constants.
  58 sSFilePrefix :: FilePath
  59 sSFilePrefix = C.ssconfFileprefix
  60
  61 $(declareSADT "SSKey"
  62   [ ("SSClusterName",          'C.ssClusterName)
  63   , ("SSClusterTags",          'C.ssClusterTags)
  64   , ("SSFileStorageDir",       'C.ssFileStorageDir)
  65   , ("SSSharedFileStorageDir", 'C.ssSharedFileStorageDir)
  66   , ("SSMasterCandidates",     'C.ssMasterCandidates)
  67   , ("SSMasterCandidatesIps",  'C.ssMasterCandidatesIps)
  68   , ("SSMasterIp",             'C.ssMasterIp)
  69   , ("SSMasterNetdev",         'C.ssMasterNetdev)
  70   , ("SSMasterNetmask",        'C.ssMasterNetmask)
  71   , ("SSMasterNode",           'C.ssMasterNode)
  72   , ("SSNodeList",             'C.ssNodeList)
  73   , ("SSNodePrimaryIps",       'C.ssNodePrimaryIps)
  74   , ("SSNodeSecondaryIps",     'C.ssNodeSecondaryIps)
  75   , ("SSOfflineNodes",         'C.ssOfflineNodes)
  76   , ("SSOnlineNodes",          'C.ssOnlineNodes)
  77   , ("SSPrimaryIpFamily",      'C.ssPrimaryIpFamily)
  78   , ("SSInstanceList",         'C.ssInstanceList)
  79   , ("SSReleaseVersion",       'C.ssReleaseVersion)
  80   , ("SSHypervisorList",       'C.ssHypervisorList)
  81   , ("SSMaintainNodeHealth",   'C.ssMaintainNodeHealth)
  82   , ("SSUidPool",              'C.ssUidPool)
  83   , ("SSNodegroups",           'C.ssNodegroups)
  84   ])
  85
  86 -- | Convert a ssconf key into a (full) file path.
  87 keyToFilename :: Maybe FilePath     -- ^ Optional config path override
  88               -> SSKey              -- ^ ssconf key
  89               -> FilePath
  90 keyToFilename optpath key = fromMaybe Path.dataDir optpath </>
  91                             sSFilePrefix ++ sSKeyToRaw key
  92
  93 -- | Runs an IO action while transforming any error into 'Bad'
  94 -- values. It also accepts an optional value to use in case the error
  95 -- is just does not exist.
  96 catchIOErrors :: Maybe a         -- ^ Optional default
  97               -> IO a            -- ^ Action to run
  98               -> IO (Result a)
  99 catchIOErrors def action =
 100   catch (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   result <- catchIOErrors def . readFile . keyToFilename optpath $ key
 115   return (liftM (take maxFileSize) result)
 116
 117 -- | Strip space characthers (including newline). As this is
 118 -- expensive, should only be run on small strings.
 119 rstripSpace :: String -> String
 120 rstripSpace = reverse . dropWhile isSpace . reverse
 121
 122 -- | Parses a string containing an IP family
 123 parseIPFamily :: Int -> Result Socket.Family
 124 parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
 125                   | fam == C.ip6Family = Ok Socket.AF_INET6
 126                   | otherwise = Bad $ "Unknown af_family value: " ++ show fam
 127
 128 -- | Read the primary IP family.
 129 getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
 130 getPrimaryIPFamily optpath = do
 131   result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
 132   return (liftM rstripSpace result >>=
 133           tryRead "Parsing af_family" >>= parseIPFamily)