1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Implementation of the Ganeti Ssconf interface.
9 Copyright (C) 2012 Google Inc.
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.
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.
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
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)
48 import qualified Ganeti.Constants as C
49 import qualified Ganeti.Path as Path
50 import Ganeti.BasicTypes
53 -- | Maximum ssconf file size we support.
57 -- | ssconf file prefix, re-exported from Constants.
58 sSFilePrefix :: FilePath
59 sSFilePrefix = C.ssconfFileprefix
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)
86 -- | Convert a ssconf key into a (full) file path.
87 keyToFilename :: Maybe FilePath -- ^ Optional config path override
88 -> SSKey -- ^ ssconf key
90 keyToFilename optpath key = fromMaybe Path.dataDir optpath </>
91 sSFilePrefix ++ sSKeyToRaw key
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
99 catchIOErrors def action =
103 ) (\err -> let bad_result = Bad (show err)
104 in return $ if isDoesNotExistError err
105 then maybe bad_result Ok def
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)
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
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
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)